From d7da0a16ea19fdff88476214c47c9003070638f7 Mon Sep 17 00:00:00 2001 From: cydparser Date: Tue, 28 Feb 2023 21:33:48 -0800 Subject: [PATCH] Add --project-dir flag --- .../src/Distribution/Client/CmdClean.hs | 12 ++- .../src/Distribution/Client/CmdOutdated.hs | 17 ++-- .../src/Distribution/Client/Config.hs | 3 +- .../src/Distribution/Client/DistDirLayout.hs | 24 +++-- .../src/Distribution/Client/ProjectConfig.hs | 99 +++++++++++++------ .../Client/ProjectConfig/Legacy.hs | 6 +- .../Client/ProjectConfig/Types.hs | 1 + .../src/Distribution/Client/ProjectFlags.hs | 39 +++++--- .../Client/ProjectOrchestration.hs | 5 +- cabal-install/tests/IntegrationTests2.hs | 29 +----- .../Distribution/Client/Configure.hs | 16 +-- .../Distribution/Client/ProjectConfig.hs | 81 +++++++++++++++ .../tests/fixtures/project-root/cabal.project | 0 .../fixtures/project-root/cabal.project.other | 0 .../tests/fixtures/project-root/lib/.gitkeep | 0 .../fixtures/project-root/nix/cabal.project | 0 .../project-root/nix/cabal.project.other | 0 .../ConditionalAndImport/cabal.test.hs | 4 +- .../Outdated/outdated-project-file.out | 2 +- .../PackageTests/ProjectDir/app/App.hs | 4 + .../PackageTests/ProjectDir/app/app.cabal | 7 ++ .../PackageTests/ProjectDir/cabal.test.hs | 23 +++++ .../PackageTests/ProjectDir/proj/App.hs | 4 + .../PackageTests/ProjectDir/proj/Lib.hs | 4 + .../ProjectDir/proj/cabal.project | 2 + .../ProjectDir/proj/nix/cabal.project | 4 + .../PackageTests/ProjectDir/proj/proj.cabal | 17 ++++ changelog.d/pr-8454 | 12 +++ doc/cabal-project.rst | 20 +++- 29 files changed, 330 insertions(+), 105 deletions(-) create mode 100644 cabal-install/tests/fixtures/project-root/cabal.project create mode 100644 cabal-install/tests/fixtures/project-root/cabal.project.other create mode 100644 cabal-install/tests/fixtures/project-root/lib/.gitkeep create mode 100644 cabal-install/tests/fixtures/project-root/nix/cabal.project create mode 100644 cabal-install/tests/fixtures/project-root/nix/cabal.project.other create mode 100644 cabal-testsuite/PackageTests/ProjectDir/app/App.hs create mode 100644 cabal-testsuite/PackageTests/ProjectDir/app/app.cabal create mode 100644 cabal-testsuite/PackageTests/ProjectDir/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/ProjectDir/proj/App.hs create mode 100644 cabal-testsuite/PackageTests/ProjectDir/proj/Lib.hs create mode 100644 cabal-testsuite/PackageTests/ProjectDir/proj/cabal.project create mode 100644 cabal-testsuite/PackageTests/ProjectDir/proj/nix/cabal.project create mode 100644 cabal-testsuite/PackageTests/ProjectDir/proj/proj.cabal create mode 100644 changelog.d/pr-8454 diff --git a/cabal-install/src/Distribution/Client/CmdClean.hs b/cabal-install/src/Distribution/Client/CmdClean.hs index d0d1a573e4c..11cb9e2f7d4 100644 --- a/cabal-install/src/Distribution/Client/CmdClean.hs +++ b/cabal-install/src/Distribution/Client/CmdClean.hs @@ -39,6 +39,7 @@ data CleanFlags = CleanFlags { cleanSaveConfig :: Flag Bool , cleanVerbosity :: Flag Verbosity , cleanDistDir :: Flag FilePath + , cleanProjectDir :: Flag FilePath , cleanProjectFile :: Flag FilePath } deriving (Eq) @@ -47,6 +48,7 @@ defaultCleanFlags = CleanFlags { cleanSaveConfig = toFlag False , cleanVerbosity = toFlag normal , cleanDistDir = NoFlag + , cleanProjectDir = mempty , cleanProjectFile = mempty } @@ -68,9 +70,12 @@ cleanCommand = CommandUI , optionDistPref cleanDistDir (\dd flags -> flags { cleanDistDir = dd }) showOrParseArgs + , option [] ["project-dir"] + "Set the path of the project directory" + cleanProjectDir (\path flags -> flags {cleanProjectDir = path}) + (reqArg "DIR" (succeedReadE Flag) flagToList) , option [] ["project-file"] - ("Set the name of the cabal.project file" - ++ " to search for in parent directories") + "Set the path of the cabal.project file (relative to the project directory when relative)" cleanProjectFile (\pf flags -> flags {cleanProjectFile = pf}) (reqArg "FILE" (succeedReadE Flag) flagToList) , option ['s'] ["save-config"] @@ -85,6 +90,7 @@ cleanAction CleanFlags{..} extraArgs _ = do let verbosity = fromFlagOrDefault normal cleanVerbosity saveConfig = fromFlagOrDefault False cleanSaveConfig mdistDirectory = flagToMaybe cleanDistDir + mprojectDir = flagToMaybe cleanProjectDir mprojectFile = flagToMaybe cleanProjectFile -- TODO interpret extraArgs as targets and clean those targets only (issue #7506) @@ -95,7 +101,7 @@ cleanAction CleanFlags{..} extraArgs _ = do die' verbosity $ "'clean' extra arguments should be script files: " ++ unwords notScripts - projectRoot <- either throwIO return =<< findProjectRoot Nothing mprojectFile + projectRoot <- either throwIO return =<< findProjectRoot verbosity mprojectDir mprojectFile let distLayout = defaultDistDirLayout projectRoot mdistDirectory diff --git a/cabal-install/src/Distribution/Client/CmdOutdated.hs b/cabal-install/src/Distribution/Client/CmdOutdated.hs index b2bf423478e..cacd57c0513 100644 --- a/cabal-install/src/Distribution/Client/CmdOutdated.hs +++ b/cabal-install/src/Distribution/Client/CmdOutdated.hs @@ -216,14 +216,14 @@ outdatedOptions _showOrParseArgs = -- | Entry point for the 'outdated' command. outdatedAction :: (ProjectFlags, OutdatedFlags) -> [String] -> GlobalFlags -> IO () -outdatedAction (ProjectFlags{flagProjectFileName}, OutdatedFlags{..}) _targetStrings globalFlags = do +outdatedAction (ProjectFlags{flagProjectDir, flagProjectFile}, OutdatedFlags{..}) _targetStrings globalFlags = do config <- loadConfigOrSandboxConfig verbosity globalFlags let globalFlags' = savedGlobalFlags config `mappend` globalFlags configFlags = savedConfigureFlags config withRepoContext verbosity globalFlags' $ \repoContext -> do - when (not newFreezeFile && isJust mprojectFile) $ + when (not newFreezeFile && (isJust mprojectDir || isJust mprojectFile)) $ die' verbosity $ - "--project-file must only be used with --v2-freeze-file." + "--project-dir and --project-file must only be used with --v2-freeze-file." sourcePkgDb <- IndexUtils.getSourcePackages verbosity repoContext (comp, platform, _progdb) <- configCompilerAux' configFlags @@ -234,7 +234,7 @@ outdatedAction (ProjectFlags{flagProjectFileName}, OutdatedFlags{..}) _targetStr httpTransport <- configureTransport verbosity (fromNubList . globalProgPathExtra $ globalFlags) (flagToMaybe . globalHttpTransport $ globalFlags) - depsFromNewFreezeFile verbosity httpTransport comp platform mprojectFile + depsFromNewFreezeFile verbosity httpTransport comp platform mprojectDir mprojectFile else do depsFromPkgDesc verbosity comp platform debug verbosity $ "Dependencies loaded: " @@ -252,7 +252,8 @@ outdatedAction (ProjectFlags{flagProjectFileName}, OutdatedFlags{..}) _targetStr else fromFlagOrDefault normal outdatedVerbosity freezeFile = fromFlagOrDefault False outdatedFreezeFile newFreezeFile = fromFlagOrDefault False outdatedNewFreezeFile - mprojectFile = flagToMaybe flagProjectFileName + mprojectDir = flagToMaybe flagProjectDir + mprojectFile = flagToMaybe flagProjectFile simpleOutput = fromFlagOrDefault False outdatedSimpleOutput quiet = fromFlagOrDefault False outdatedQuiet exitCode = fromFlagOrDefault quiet outdatedExitCode @@ -298,10 +299,10 @@ depsFromFreezeFile verbosity = do return deps -- | Read the list of dependencies from the new-style freeze file. -depsFromNewFreezeFile :: Verbosity -> HttpTransport -> Compiler -> Platform -> Maybe FilePath -> IO [PackageVersionConstraint] -depsFromNewFreezeFile verbosity httpTransport compiler (Platform arch os) mprojectFile = do +depsFromNewFreezeFile :: Verbosity -> HttpTransport -> Compiler -> Platform -> Maybe FilePath -> Maybe FilePath -> IO [PackageVersionConstraint] +depsFromNewFreezeFile verbosity httpTransport compiler (Platform arch os) mprojectDir mprojectFile = do projectRoot <- either throwIO return =<< - findProjectRoot Nothing mprojectFile + findProjectRoot verbosity mprojectDir mprojectFile let distDirLayout = defaultDistDirLayout projectRoot {- TODO: Support dist dir override -} Nothing projectConfig <- runRebuild (distProjectRootDirectory distDirLayout) $ do diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index b829b51bd4f..33793657282 100644 --- a/cabal-install/src/Distribution/Client/Config.hs +++ b/cabal-install/src/Distribution/Client/Config.hs @@ -525,7 +525,8 @@ instance Semigroup SavedConfig where lastNonEmpty = lastNonEmpty' savedBenchmarkFlags combinedSavedProjectFlags = ProjectFlags - { flagProjectFileName = combine flagProjectFileName + { flagProjectDir = combine flagProjectDir + , flagProjectFile = combine flagProjectFile , flagIgnoreProject = combine flagIgnoreProject } where diff --git a/cabal-install/src/Distribution/Client/DistDirLayout.hs b/cabal-install/src/Distribution/Client/DistDirLayout.hs index 2b88ddc4302..2413c3acf90 100644 --- a/cabal-install/src/Distribution/Client/DistDirLayout.hs +++ b/cabal-install/src/Distribution/Client/DistDirLayout.hs @@ -10,7 +10,10 @@ module Distribution.Client.DistDirLayout ( DistDirLayout(..), DistDirParams(..), defaultDistDirLayout, + + -- * 'ProjectRoot' ProjectRoot(..), + defaultProjectFile, -- * 'StoreDirLayout' StoreDirLayout(..), @@ -64,7 +67,7 @@ data DistDirParams = DistDirParams { data DistDirLayout = DistDirLayout { -- | The root directory of the project. Many other files are relative to - -- this location. In particular, the @cabal.project@ lives here. + -- this location (e.g. the @cabal.project@ file). -- distProjectRootDirectory :: FilePath, @@ -156,18 +159,26 @@ data CabalDirLayout = CabalDirLayout { -- | Information about the root directory of the project. -- -- It can either be an implicit project root in the current dir if no --- @cabal.project@ file is found, or an explicit root if the file is found. +-- @cabal.project@ file is found, or an explicit root if either +-- the file is found or the project root directory was specicied. -- data ProjectRoot = - -- | -- ^ An implicit project root. It contains the absolute project + -- | An implicit project root. It contains the absolute project -- root dir. ProjectRootImplicit FilePath - -- | -- ^ An explicit project root. It contains the absolute project + -- | An explicit project root. It contains the absolute project -- root dir and the relative @cabal.project@ file (or explicit override) | ProjectRootExplicit FilePath FilePath + + -- | An explicit, absolute project root dir and an explicit, absolute + -- @cabal.project@ file. + | ProjectRootExplicitAbsolute FilePath FilePath deriving (Eq, Show) +defaultProjectFile :: FilePath +defaultProjectFile = "cabal.project" + -- | Make the default 'DistDirLayout' based on the project root dir and -- optional overrides for the location of the @dist@ directory and the -- @cabal.project@ file. @@ -180,8 +191,9 @@ defaultDistDirLayout projectRoot mdistDirectory = DistDirLayout {..} where (projectRootDir, projectFile) = case projectRoot of - ProjectRootImplicit dir -> (dir, dir "cabal.project") - ProjectRootExplicit dir file -> (dir, dir file) + ProjectRootImplicit dir -> (dir, dir defaultProjectFile) + ProjectRootExplicit dir file -> (dir, dir file) + ProjectRootExplicitAbsolute dir file -> (dir, file) distProjectRootDirectory :: FilePath distProjectRootDirectory = projectRootDir diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs index 83184d5902c..0807a305815 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs @@ -22,7 +22,7 @@ module Distribution.Client.ProjectConfig ( -- * Project root findProjectRoot, ProjectRoot(..), - BadProjectRoot(..), + BadProjectRoot, -- * Project config files readProjectConfig, @@ -73,7 +73,7 @@ import Distribution.Client.VCS import Distribution.Client.Types import Distribution.Client.DistDirLayout - ( DistDirLayout(..), CabalDirLayout(..), ProjectRoot(..) ) + ( DistDirLayout(..), CabalDirLayout(..), ProjectRoot(..), defaultProjectFile ) import Distribution.Client.GlobalFlags ( RepoContext(..), withRepoContext' ) import Distribution.Client.BuildReports.Types @@ -400,30 +400,61 @@ resolveBuildTimeSettings verbosity -- | Find the root of this project. -- --- Searches for an explicit @cabal.project@ file, in the current directory or --- parent directories. If no project file is found then the current dir is the --- project root (and the project will use an implicit config). +-- The project directory will be one of the following: +-- 1. @mprojectDir@ when present +-- 2. The first directory containing @mprojectFile@/@cabal.project@, starting from the current directory +-- and recursively checking parent directories +-- 3. The current directory -- -findProjectRoot :: Maybe FilePath -- ^ starting directory, or current directory - -> Maybe FilePath -- ^ @cabal.project@ file name override - -> IO (Either BadProjectRoot ProjectRoot) -findProjectRoot _ (Just projectFile) - | isAbsolute projectFile = do - exists <- doesFileExist projectFile - if exists - then do projectFile' <- canonicalizePath projectFile - let projectRoot = ProjectRootExplicit (takeDirectory projectFile') - (takeFileName projectFile') - return (Right projectRoot) - else return (Left (BadProjectRootExplicitFile projectFile)) - -findProjectRoot mstartdir mprojectFile = do - startdir <- maybe getCurrentDirectory canonicalizePath mstartdir +findProjectRoot + :: Verbosity + -> Maybe FilePath -- ^ Explicit project directory + -> Maybe FilePath -- ^ Explicit project file + -> IO (Either BadProjectRoot ProjectRoot) +findProjectRoot verbosity mprojectDir mprojectFile = do + case mprojectDir of + Nothing + | Just file <- mprojectFile, isAbsolute file -> do + warn verbosity $ + "Specifying an absolute path to the project file is deprecated." + <> " Use --project-dir to set the project's directory." + + doesFileExist file >>= \case + False -> left (BadProjectRootExplicitFile file) + True -> uncurry projectRoot =<< first dropTrailingPathSeparator . splitFileName <$> canonicalizePath file + + | otherwise -> probeProjectRoot mprojectFile + + Just dir -> doesDirectoryExist dir >>= \case + False -> left (BadProjectRootDir dir) + True -> do + projectDir <- canonicalizePath dir + + case mprojectFile of + Nothing -> pure $ Right (ProjectRootExplicit projectDir defaultProjectFile) + + Just projectFile + | isAbsolute projectFile -> doesFileExist projectFile >>= \case + False -> left (BadProjectRootAbsoluteFile projectFile) + True -> Right . ProjectRootExplicitAbsolute dir <$> canonicalizePath projectFile + + | otherwise -> doesFileExist (projectDir projectFile) >>= \case + False -> left (BadProjectRootDirFile dir projectFile) + True -> projectRoot projectDir projectFile + where + left = pure . Left + + projectRoot projectDir projectFile = + pure $ Right (ProjectRootExplicit projectDir projectFile) + +probeProjectRoot :: Maybe FilePath -> IO (Either BadProjectRoot ProjectRoot) +probeProjectRoot mprojectFile = do + startdir <- getCurrentDirectory homedir <- getHomeDirectory probe startdir homedir where projectFileName :: String - projectFileName = fromMaybe "cabal.project" mprojectFile + projectFileName = fromMaybe defaultProjectFile mprojectFile -- Search upwards. If we get to the users home dir or the filesystem root, -- then use the current dir @@ -443,7 +474,11 @@ findProjectRoot mstartdir mprojectFile = do -- | Errors returned by 'findProjectRoot'. -- -data BadProjectRoot = BadProjectRootExplicitFile FilePath +data BadProjectRoot + = BadProjectRootExplicitFile FilePath + | BadProjectRootDir FilePath + | BadProjectRootAbsoluteFile FilePath + | BadProjectRootDirFile FilePath FilePath #if MIN_VERSION_base(4,8,0) deriving (Show, Typeable) #else @@ -459,9 +494,19 @@ instance Exception BadProjectRoot where #endif renderBadProjectRoot :: BadProjectRoot -> String -renderBadProjectRoot (BadProjectRootExplicitFile projectFile) = +renderBadProjectRoot = \case + BadProjectRootExplicitFile projectFile -> "The given project file '" ++ projectFile ++ "' does not exist." + BadProjectRootDir dir -> + "The given project directory '" <> dir <> "' does not exist." + + BadProjectRootAbsoluteFile file -> + "The given project file '" <> file <> "' does not exist." + + BadProjectRootDirFile dir file -> + "The given project directory/file combination '" <> dir file <> "' does not exist." + withProjectOrGlobalConfig :: Verbosity -- ^ verbosity -> Flag Bool -- ^ whether to ignore local project (--ignore-project flag) @@ -484,8 +529,7 @@ withProjectOrGlobalConfig' withProjectOrGlobalConfig' verbosity globalConfigFlag with without = do globalConfig <- runRebuild "" $ readGlobalConfig verbosity globalConfigFlag - let - res' = catch with + catch with $ \case (BadPackageLocations prov locs) | prov == Set.singleton Implicit @@ -496,11 +540,6 @@ withProjectOrGlobalConfig' verbosity globalConfigFlag with without = do without globalConfig err -> throwIO err - catch res' - $ \case - (BadProjectRootExplicitFile "") -> without globalConfig - err -> throwIO err - -- | Read all the config relevant for a project. This includes the project -- file if any, plus other global config. -- diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs index 7ed747fa98e..6d157e25d60 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs @@ -540,7 +540,8 @@ convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags } = installFlags ProjectFlags - { flagProjectFileName = projectConfigProjectFile + { flagProjectDir = projectConfigProjectDir + , flagProjectFile = projectConfigProjectFile , flagIgnoreProject = projectConfigIgnoreProject } = projectFlags @@ -801,7 +802,8 @@ convertToLegacySharedConfig } projectFlags = ProjectFlags - { flagProjectFileName = projectConfigProjectFile + { flagProjectDir = projectConfigProjectDir + , flagProjectFile = projectConfigProjectFile , flagIgnoreProject = projectConfigIgnoreProject } diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs index be3aae9bd5c..71956702589 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs @@ -162,6 +162,7 @@ data ProjectConfigShared = ProjectConfigShared { projectConfigDistDir :: Flag FilePath, projectConfigConfigFile :: Flag FilePath, + projectConfigProjectDir :: Flag FilePath, projectConfigProjectFile :: Flag FilePath, projectConfigIgnoreProject :: Flag Bool, projectConfigHcFlavor :: Flag CompilerFlavor, diff --git a/cabal-install/src/Distribution/Client/ProjectFlags.hs b/cabal-install/src/Distribution/Client/ProjectFlags.hs index bf1d5789edc..8959f60aefc 100644 --- a/cabal-install/src/Distribution/Client/ProjectFlags.hs +++ b/cabal-install/src/Distribution/Client/ProjectFlags.hs @@ -17,12 +17,17 @@ import Distribution.Simple.Command import Distribution.Simple.Setup (Flag (..), flagToList, flagToMaybe, toFlag, trueArg) data ProjectFlags = ProjectFlags - { flagProjectFileName :: Flag FilePath - -- ^ The cabal project file name; defaults to @cabal.project@. - -- The name itself denotes the cabal project file name, but it also + { flagProjectDir :: Flag FilePath + -- ^ The project directory. + + , flagProjectFile :: Flag FilePath + -- ^ The cabal project file path; defaults to @cabal.project@. + -- This path, when relative, is relative to the project directory. + -- The filename portion of the path denotes the cabal project file name, but it also -- is the base of auxiliary project files, such as -- @cabal.project.local@ and @cabal.project.freeze@ which are also - -- read and written out in some cases. If the path is not found + -- read and written out in some cases. + -- If a project directory was not specified, and the path is not found -- in the current working directory, we will successively probe -- relative to parent directories until this name is found. @@ -34,23 +39,31 @@ data ProjectFlags = ProjectFlags defaultProjectFlags :: ProjectFlags defaultProjectFlags = ProjectFlags - { flagProjectFileName = mempty + { flagProjectDir = mempty + , flagProjectFile = mempty , flagIgnoreProject = toFlag False -- Should we use 'Last' here? } projectFlagsOptions :: ShowOrParseArgs -> [OptionField ProjectFlags] projectFlagsOptions showOrParseArgs = - [ option [] ["project-file"] - "Set the name of the cabal.project file to search for in parent directories" - flagProjectFileName (\pf flags -> flags { flagProjectFileName = pf }) + [ option [] ["project-dir"] + "Set the path of the project directory" + flagProjectDir (\path flags -> flags { flagProjectDir = path }) + (reqArg "DIR" (succeedReadE Flag) flagToList) + , option [] ["project-file"] + "Set the path of the cabal.project file (relative to the project directory when relative)" + flagProjectFile (\pf flags -> flags { flagProjectFile = pf }) (reqArg "FILE" (succeedReadE Flag) flagToList) , option ['z'] ["ignore-project"] - "Ignore local project configuration" - -- Flag True: --ignore-project is given and --project-file is not given - -- Flag False: --ignore-project and --project-file is given - -- NoFlag: neither --ignore-project or --project-file is given - flagIgnoreProject (\v flags -> flags { flagIgnoreProject = if v == NoFlag then NoFlag else toFlag ((flagProjectFileName flags) == NoFlag && v == Flag True) }) + "Ignore local project configuration (unless --project-dir or --project-file is also set)" + flagIgnoreProject + (\v flags -> flags + { flagIgnoreProject = case v of + Flag True -> toFlag (flagProjectDir flags == NoFlag && flagProjectFile flags == NoFlag) + _ -> v + } + ) (yesNoOpt showOrParseArgs) ] diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs index da67b8a3ef4..5b9caf13b8f 100644 --- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs @@ -208,11 +208,12 @@ establishProjectBaseContext -> CurrentCommand -> IO ProjectBaseContext establishProjectBaseContext verbosity cliConfig currentCommand = do - projectRoot <- either throwIO return =<< findProjectRoot Nothing mprojectFile + projectRoot <- either throwIO return =<< findProjectRoot verbosity mprojectDir mprojectFile establishProjectBaseContextWithRoot verbosity cliConfig projectRoot currentCommand where + mprojectDir = Setup.flagToMaybe projectConfigProjectDir mprojectFile = Setup.flagToMaybe projectConfigProjectFile - ProjectConfigShared { projectConfigProjectFile} = projectConfigShared cliConfig + ProjectConfigShared { projectConfigProjectDir, projectConfigProjectFile } = projectConfigShared cliConfig -- | Like 'establishProjectBaseContext' but doesn't search for project root. establishProjectBaseContextWithRoot diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs index 90d272aacae..ac734000c0e 100644 --- a/cabal-install/tests/IntegrationTests2.hs +++ b/cabal-install/tests/IntegrationTests2.hs @@ -99,9 +99,7 @@ tests config = -- * normal success -- * dry-run tests with changes [ testGroup "Discovery and planning" $ - [ testCase "find root" testFindProjectRoot - , testCase "find root fail" testExceptionFindProjectRoot - , testCase "no package" (testExceptionInFindingPackage config) + [ testCase "no package" (testExceptionInFindingPackage config) , testCase "no package2" (testExceptionInFindingPackage2 config) , testCase "proj conf1" (testExceptionInProjectConfig config) ] @@ -153,25 +151,6 @@ tests config = ] ] -testFindProjectRoot :: Assertion -testFindProjectRoot = do - Left (BadProjectRootExplicitFile file) <- findProjectRoot (Just testdir) - (Just testfile) - file @?= testfile - where - testdir = basedir "exception" "no-pkg2" - testfile = "bklNI8O1OpOUuDu3F4Ij4nv3oAqN" - - -testExceptionFindProjectRoot :: Assertion -testExceptionFindProjectRoot = do - Right (ProjectRootExplicit dir _) <- findProjectRoot (Just testdir) Nothing - cwd <- getCurrentDirectory - dir @?= cwd testdir - where - testdir = basedir "exception" "no-pkg2" - - testTargetSelectors :: (String -> IO ()) -> Assertion testTargetSelectors reportSubCase = do (_, _, _, localPackages, _) <- configureProject testdir config @@ -1681,10 +1660,10 @@ configureProject testdir cliConfig = do cabalDirLayout <- defaultCabalDirLayout projectRootDir <- canonicalizePath (basedir testdir) - isexplict <- doesFileExist (projectRootDir "cabal.project") + isexplict <- doesFileExist (projectRootDir defaultProjectFile) + let projectRoot - | isexplict = ProjectRootExplicit projectRootDir - (projectRootDir "cabal.project") + | isexplict = ProjectRootExplicit projectRootDir defaultProjectFile | otherwise = ProjectRootImplicit projectRootDir distDirLayout = defaultDistDirLayout projectRoot Nothing diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Configure.hs b/cabal-install/tests/UnitTests/Distribution/Client/Configure.hs index 642e4c6e358..91a61358ade 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Configure.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Configure.hs @@ -45,7 +45,7 @@ configureTests = testGroup "Configure tests" , configVerbosity = Flag silent } , projectFlags = mempty - { flagProjectFileName = Flag projectFile } + { flagProjectDir = Flag projectDir } } (_, ProjectConfig {..}) <- configureAction' flags [] defaultGlobalFlags @@ -59,7 +59,7 @@ configureTests = testGroup "Configure tests" , configFlags = mempty { configVerbosity = Flag silent } , projectFlags = mempty - { flagProjectFileName = Flag projectFile } + { flagProjectDir = Flag projectDir } } (_, ProjectConfig {..}) <- configureAction' flags [] defaultGlobalFlags @@ -71,7 +71,7 @@ configureTests = testGroup "Configure tests" { configFlags = mempty { configVerbosity = Flag silent } , projectFlags = mempty - { flagProjectFileName = Flag projectFile } + { flagProjectDir = Flag projectDir } } (_, ProjectConfig {..}) <- configureAction' flags [] defaultGlobalFlags @@ -83,9 +83,9 @@ configureTests = testGroup "Configure tests" { configFlags = mempty { configVerbosity = Flag silent } , projectFlags = mempty - { flagProjectFileName = Flag projectFile } + { flagProjectDir = Flag projectDir } } - backup = projectFile <.> "local~" + backup = projectDir "cabal.project.local~" exists <- doesFileExist backup when exists $ @@ -104,7 +104,7 @@ configureTests = testGroup "Configure tests" , configProgramArgs = [("ghc", ghcFlags)] } , projectFlags = mempty - { flagProjectFileName = Flag projectFile } + { flagProjectDir = Flag projectDir } } (_, ProjectConfig {..}) <- configureAction' flags [] defaultGlobalFlags @@ -118,5 +118,5 @@ configureTests = testGroup "Configure tests" (Map.lookup "ghc" (getMapMappend (packageConfigProgramArgs projectConfigLocalPackages))) ] -projectFile :: FilePath -projectFile = "tests" "fixtures" "configure" "cabal.project" +projectDir :: FilePath +projectDir = "tests" "fixtures" "configure" diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs index 94f4190880e..840845b34e0 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs @@ -14,10 +14,17 @@ module UnitTests.Distribution.Client.ProjectConfig (tests) where import Data.Monoid import Control.Applicative #endif +import Control.Monad +import Data.Either (isRight) +import Data.Foldable (for_) import Data.Map (Map) import qualified Data.Map as Map import Data.List (isPrefixOf, intercalate, (\\)) +import Data.Maybe (fromMaybe) import Network.URI (URI) +import System.Directory (withCurrentDirectory, canonicalizePath) +import System.FilePath +import System.IO.Unsafe (unsafePerformIO) import Distribution.Deprecated.ParseUtils import qualified Distribution.Deprecated.ReadP as Parse @@ -35,12 +42,14 @@ import Distribution.Types.PackageVersionConstraint import Distribution.Parsec import Distribution.Pretty +import Distribution.Client.DistDirLayout (defaultProjectFile) import Distribution.Client.Types import Distribution.Client.CmdInstall.ClientInstallFlags import Distribution.Client.Dependency.Types import Distribution.Client.Targets import Distribution.Client.Types.SourceRepo import Distribution.Utils.NubList +import Distribution.Verbosity (silent) import Distribution.Solver.Types.PackageConstraint import Distribution.Solver.Types.ConstraintSource @@ -55,6 +64,7 @@ import UnitTests.Distribution.Client.TreeDiffInstances () import Data.TreeDiff.Class import Data.TreeDiff.QuickCheck import Test.Tasty +import Test.Tasty.HUnit import Test.Tasty.QuickCheck tests :: [TestTree] @@ -89,6 +99,7 @@ tests = , testProperty "specific" prop_roundtrip_printparse_specific , testProperty "all" prop_roundtrip_printparse_all ] + , testFindProjectRoot ] where usingGhc76orOlder = @@ -96,6 +107,73 @@ tests = CompilerId GHC v -> v < mkVersion [7,7] _ -> False +testFindProjectRoot :: TestTree +testFindProjectRoot = testGroup "findProjectRoot" + [ test "defaults" (cd dir) Nothing Nothing (succeeds dir file) + , test "defaults in lib" (cd libDir) Nothing Nothing (succeeds dir file) + + , test "explicit file" (cd dir) Nothing (Just file) (succeeds dir file) + , test "explicit file in lib" (cd libDir) Nothing (Just file) (succeeds dir file) + + , test "other file" (cd dir) Nothing (Just fileOther) (succeeds dir fileOther) + , test "other file in lib" (cd libDir) Nothing (Just fileOther) (succeeds dir fileOther) + + -- Deprecated use-case + , test "absolute file" Nothing Nothing (Just absFile) (succeeds dir file) + + , test "nested file" (cd dir) Nothing (Just nixFile) (succeeds dir nixFile) + , test "nested file in lib" (cd libDir) Nothing (Just nixFile) (succeeds dir nixFile) + + , test "explicit dir" Nothing (Just dir) Nothing (succeeds dir file) + , test "explicit dir & file" Nothing (Just dir) (Just file) (succeeds dir file) + , test "explicit dir & nested file" Nothing (Just dir) (Just nixFile) (succeeds dir nixFile) + , test "explicit dir & nested other file" Nothing (Just dir) (Just nixOther) (succeeds dir nixOther) + + , test "explicit dir & absolute file" Nothing (Just dir) (Just absFile) (succeedsWith ProjectRootExplicitAbsolute dir absFile) + ] + where + dir = fixturesDir "project-root" + libDir = dir "lib" + + file = defaultProjectFile + fileOther = file <.> "other" + absFile = dir file + + nixFile = "nix" file + nixOther = nixFile <.> "other" + + missing path = Just (path <.> "does_not_exist") + + test name wrap projectDir projectFile validate = + testCaseSteps name $ \step -> fromMaybe id wrap $ do + result <- findProjectRoot silent projectDir projectFile + _ <- validate result + + when (isRight result) $ do + for_ projectDir $ \path -> do + step "missing project dir" + fails =<< findProjectRoot silent (missing path) projectFile + + for_ projectFile $ \path -> do + step "missing project file" + fails =<< findProjectRoot silent projectDir (missing path) + + cd d = Just (withCurrentDirectory d) + + succeeds = succeedsWith ProjectRootExplicit + + succeedsWith mk projectDir projectFile result = case result of + Left err -> assertFailure $ "Expected ProjectRoot, but found " <> show err + Right pr -> pr @?= mk projectDir projectFile + + fails result = case result of + Left _ -> pure () + Right x -> assertFailure $ "Expected an error, but found " <> show x + +fixturesDir :: FilePath +fixturesDir = unsafePerformIO $ + canonicalizePath ("tests" "fixtures") +{-# NOINLINE fixturesDir #-} ------------------------------------------------ -- Round trip: conversion to/from legacy types @@ -220,6 +298,7 @@ hackProjectConfigShared :: ProjectConfigShared -> ProjectConfigShared hackProjectConfigShared config = config { projectConfigProjectFile = mempty, -- not present within project files + projectConfigProjectDir = mempty, -- ditto projectConfigConfigFile = mempty, -- ditto projectConfigConstraints = --TODO: [required eventually] parse ambiguity in constraint @@ -451,6 +530,7 @@ instance Arbitrary ProjectConfigShared where arbitrary = do projectConfigDistDir <- arbitraryFlag arbitraryShortToken projectConfigConfigFile <- arbitraryFlag arbitraryShortToken + projectConfigProjectDir <- arbitraryFlag arbitraryShortToken projectConfigProjectFile <- arbitraryFlag arbitraryShortToken projectConfigIgnoreProject <- arbitrary projectConfigHcFlavor <- arbitrary @@ -493,6 +573,7 @@ instance Arbitrary ProjectConfigShared where shrink ProjectConfigShared {..} = runShrinker $ pure ProjectConfigShared <*> shrinker projectConfigDistDir <*> shrinker projectConfigConfigFile + <*> shrinker projectConfigProjectDir <*> shrinker projectConfigProjectFile <*> shrinker projectConfigIgnoreProject <*> shrinker projectConfigHcFlavor diff --git a/cabal-install/tests/fixtures/project-root/cabal.project b/cabal-install/tests/fixtures/project-root/cabal.project new file mode 100644 index 00000000000..e69de29bb2d diff --git a/cabal-install/tests/fixtures/project-root/cabal.project.other b/cabal-install/tests/fixtures/project-root/cabal.project.other new file mode 100644 index 00000000000..e69de29bb2d diff --git a/cabal-install/tests/fixtures/project-root/lib/.gitkeep b/cabal-install/tests/fixtures/project-root/lib/.gitkeep new file mode 100644 index 00000000000..e69de29bb2d diff --git a/cabal-install/tests/fixtures/project-root/nix/cabal.project b/cabal-install/tests/fixtures/project-root/nix/cabal.project new file mode 100644 index 00000000000..e69de29bb2d diff --git a/cabal-install/tests/fixtures/project-root/nix/cabal.project.other b/cabal-install/tests/fixtures/project-root/nix/cabal.project.other new file mode 100644 index 00000000000..e69de29bb2d diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.test.hs b/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.test.hs index 0791050f66d..92ad43e8ba1 100644 --- a/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.test.hs @@ -2,5 +2,5 @@ import Test.Cabal.Prelude main = cabalTest $ withRepo "repo" $ do cabal "v2-run" [ "some-exe" ] - fails $ cabal "v2-build" [ "--project=cabal-cyclical.project" ] - fails $ cabal "v2-build" [ "--project=cabal-bad-conditional.project" ] + fails $ cabal "v2-build" [ "--project-file=cabal-cyclical.project" ] + fails $ cabal "v2-build" [ "--project-file=cabal-bad-conditional.project" ] diff --git a/cabal-testsuite/PackageTests/Outdated/outdated-project-file.out b/cabal-testsuite/PackageTests/Outdated/outdated-project-file.out index 8a0f972a394..e4830cef2bd 100644 --- a/cabal-testsuite/PackageTests/Outdated/outdated-project-file.out +++ b/cabal-testsuite/PackageTests/Outdated/outdated-project-file.out @@ -7,4 +7,4 @@ base ==3.0.3.2 (latest: 4.0.0.0) Outdated dependencies: base ==3.0.3.2 (latest: 4.0.0.0) # cabal outdated -Error: cabal: --project-file must only be used with --v2-freeze-file. +Error: cabal: --project-dir and --project-file must only be used with --v2-freeze-file. diff --git a/cabal-testsuite/PackageTests/ProjectDir/app/App.hs b/cabal-testsuite/PackageTests/ProjectDir/app/App.hs new file mode 100644 index 00000000000..89ad4b3e08f --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDir/app/App.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = pure () diff --git a/cabal-testsuite/PackageTests/ProjectDir/app/app.cabal b/cabal-testsuite/PackageTests/ProjectDir/app/app.cabal new file mode 100644 index 00000000000..d0be3363e49 --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDir/app/app.cabal @@ -0,0 +1,7 @@ +cabal-version: 3.6 +name: app +version: 0.1 + +executable app + main-is: App.hs + build-depends: base diff --git a/cabal-testsuite/PackageTests/ProjectDir/cabal.test.hs b/cabal-testsuite/PackageTests/ProjectDir/cabal.test.hs new file mode 100644 index 00000000000..5ac2fe9cc6a --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDir/cabal.test.hs @@ -0,0 +1,23 @@ +import Test.Cabal.Prelude + +main :: IO () +main = cabalTest $ recordMode DoNotRecord $ do + env <- getTestEnv + + let cwd = testCurrentDir env + + -- Relative directory + cabal "v2-build" [ "--project-dir=proj", "all" ] + + -- Absolute directory + cabal "v2-build" [ "--project-dir", (cwd "proj"), "all" ] + + cabal "v2-clean" [ "--project-dir=proj" ] + + withProjectFile "nix/cabal.project" $ do + cabal "v2-build" [ "--project-dir=proj", "extra" ] + + cabal "v2-clean" [ "--project-dir=proj" ] + + -- App with no cabal.project + void $ cabal_raw' [ "run", "--project-dir=app", "app" ] Nothing diff --git a/cabal-testsuite/PackageTests/ProjectDir/proj/App.hs b/cabal-testsuite/PackageTests/ProjectDir/proj/App.hs new file mode 100644 index 00000000000..89ad4b3e08f --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDir/proj/App.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = pure () diff --git a/cabal-testsuite/PackageTests/ProjectDir/proj/Lib.hs b/cabal-testsuite/PackageTests/ProjectDir/proj/Lib.hs new file mode 100644 index 00000000000..d3f160129b5 --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDir/proj/Lib.hs @@ -0,0 +1,4 @@ +module Lib where + +x :: () +x = () diff --git a/cabal-testsuite/PackageTests/ProjectDir/proj/cabal.project b/cabal-testsuite/PackageTests/ProjectDir/proj/cabal.project new file mode 100644 index 00000000000..b764c340a62 --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDir/proj/cabal.project @@ -0,0 +1,2 @@ +packages: . + diff --git a/cabal-testsuite/PackageTests/ProjectDir/proj/nix/cabal.project b/cabal-testsuite/PackageTests/ProjectDir/proj/nix/cabal.project new file mode 100644 index 00000000000..60e863b1c6f --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDir/proj/nix/cabal.project @@ -0,0 +1,4 @@ +packages: . + +package proj + flags: +extra diff --git a/cabal-testsuite/PackageTests/ProjectDir/proj/proj.cabal b/cabal-testsuite/PackageTests/ProjectDir/proj/proj.cabal new file mode 100644 index 00000000000..be296dbc972 --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDir/proj/proj.cabal @@ -0,0 +1,17 @@ +cabal-version: 3.8 +name: proj +version: 0.1 + +flag extra + default: False + manual: True + +library + build-depends: base + exposed-modules: Lib + +executable extra + build-depends: base + main-is: App.hs + if !flag(extra) + buildable: False diff --git a/changelog.d/pr-8454 b/changelog.d/pr-8454 new file mode 100644 index 00000000000..915caf61cc9 --- /dev/null +++ b/changelog.d/pr-8454 @@ -0,0 +1,12 @@ +synopsis: Add --project-dir flag +packages: cabal-install +prs: #8454 +issues: #7695 #7940 +significance: significant + +description: { + +- Added --project-dir flag for specifying the project's root directory +- Deprecated using --project-file with an absolute filepath without also using --project-dir + +} diff --git a/doc/cabal-project.rst b/doc/cabal-project.rst index a1cec73a905..9d7add2f688 100644 --- a/doc/cabal-project.rst +++ b/doc/cabal-project.rst @@ -290,10 +290,21 @@ package, and thus apply globally: This option cannot be specified via a ``cabal.project`` file. +.. _cmdoption-project-dir: +.. option:: --project-dir=DIR + + Specifies the path of the project directory. If a relative + :ref:`project-file` path is also specified, + it will be resolved relative to this directory. + + The project directory need not contain a ``cabal.project`` file. + + This option cannot be specified via a ``cabal.project`` file. + .. _cmdoption-project-file: .. option:: --project-file=FILE - Specifies the name of the project file used to specify the + Specifies the path and name of the project file used to specify the rest of the top-level configuration; defaults to ``cabal.project``. This name not only specifies the name of the main project file, but also the auxiliary project files ``cabal.project.freeze`` @@ -301,7 +312,8 @@ package, and thus apply globally: ``--project-file=my.project``, then the other files that will be probed are ``my.project.freeze`` and ``my.project.local``. - If the specified project file is a relative path, we will + If :ref:`project-dir` is not specified, + and the path is relative, we will look for the file relative to the current working directory, and then for the parent directory, until the project file is found or we have hit the top of the user's home directory. @@ -312,8 +324,8 @@ package, and thus apply globally: Ignores the local ``cabal.project`` file and uses the default configuration with the local ``foo.cabal`` file. Note that - if this flag is set while the ``--project-file`` flag is also - set then this flag will be ignored. + this flag will be ignored if either of the ``--project-dir`` or + ``--project-file`` flags are also set. .. option:: --store-dir=DIR