Make Setup.hs configure more CWD-independent.

Cabal/ChangeLog.md

@@ -61,6 +61,8 @@
     path components on Windows and warn about other unsafe characters
     in the path to the source directory on all platforms
     ([#5386](https://github.com/haskell/cabal/issues/5386)).
+  * `Distribution.PackageDescription.Check.checkPackageFiles` now
+    accepts a `Verbosity` argument.
 
 ----
 

Cabal/Distribution/PackageDescription/Check.hs

@@ -1840,10 +1840,10 @@ checkDevelopmentOnlyFlags pkg =
 -- | Sanity check things that requires IO. It looks at the files in the
 -- package and expects to find the package unpacked in at the given file path.
 --
-checkPackageFiles :: PackageDescription -> FilePath -> NoCallStackIO [PackageCheck]
-checkPackageFiles pkg root = do
+checkPackageFiles :: Verbosity -> PackageDescription -> FilePath -> NoCallStackIO [PackageCheck]
+checkPackageFiles verbosity pkg root = do
   contentChecks <- checkPackageContent checkFilesIO pkg
-  missingFileChecks <- checkPackageMissingFiles pkg root
+  missingFileChecks <- checkPackageMissingFiles verbosity pkg root
   -- Sort because different platforms will provide files from
   -- `getDirectoryContents` in different orders, and we'd like to be
   -- stable for test output.
@@ -2155,20 +2155,20 @@ checkTarPath path
 -- check these on the server; these checks only make sense in the development
 -- and package-creation environment. Hence we can use IO, rather than needing
 -- to pass a 'CheckPackageContentOps' dictionary around.
-checkPackageMissingFiles :: PackageDescription -> FilePath -> NoCallStackIO [PackageCheck]
+checkPackageMissingFiles :: Verbosity -> PackageDescription -> FilePath -> NoCallStackIO [PackageCheck]
 checkPackageMissingFiles = checkGlobMultiDot
 
 -- | Before Cabal 2.4, the extensions of globs had to match the file
 -- exactly. This has been relaxed in 2.4 to allow matching only the
 -- suffix. This warning detects when pre-2.4 package descriptions are
 -- omitting files purely because of the stricter check.
-checkGlobMultiDot :: PackageDescription
+checkGlobMultiDot :: Verbosity
+                  -> PackageDescription
                   -> FilePath
                   -> NoCallStackIO [PackageCheck]
-checkGlobMultiDot pkg root =
+checkGlobMultiDot verbosity pkg root =
   fmap concat $ for allGlobs $ \(field, dir, glob) -> do
-    --TODO: baked-in verbosity
-    results <- matchDirFileGlob' normal (specVersion pkg) (root </> dir) glob
+    results <- matchDirFileGlob' verbosity (specVersion pkg) (root </> dir) glob
     return
       [ PackageDistSuspiciousWarn $
              "In '" ++ field ++ "': the pattern '" ++ glob ++ "' does not"

Cabal/Distribution/Simple/Configure.hs

@@ -473,8 +473,10 @@ configure (pkg_descr0, pbi) cfg = do
     debug verbosity $ "Finalized package description:\n"
                   ++ showPackageDescription pkg_descr
 
+    let cabalFileDir = maybe "." takeDirectory $
+          flagToMaybe (configCabalFilePath cfg)
     checkCompilerProblems verbosity comp pkg_descr enabled
-    checkPackageProblems verbosity pkg_descr0
+    checkPackageProblems verbosity cabalFileDir pkg_descr0
         (updatePackageDescription pbi pkg_descr)
 
     -- The list of 'InstalledPackageInfo' recording the selected
@@ -1841,11 +1843,13 @@ checkForeignDeps pkg lbi verbosity =
 
 -- | Output package check warnings and errors. Exit if any errors.
 checkPackageProblems :: Verbosity
+                     -> FilePath
+                        -- ^ Path to the @.cabal@ file's directory
                      -> GenericPackageDescription
                      -> PackageDescription
                      -> IO ()
-checkPackageProblems verbosity gpkg pkg = do
-  ioChecks      <- checkPackageFiles pkg "."
+checkPackageProblems verbosity dir gpkg pkg = do
+  ioChecks      <- checkPackageFiles verbosity pkg dir
   let pureChecks = checkPackage gpkg (Just pkg)
       errors   = [ e | PackageBuildImpossible e <- pureChecks ++ ioChecks ]
       warnings = [ w | PackageBuildWarning    w <- pureChecks ++ ioChecks ]

Cabal/Distribution/Simple/SrcDist.hs

@@ -468,9 +468,11 @@ allSourcesBuildInfo verbosity bi pps modules = do
                  ++ "is autogenerated it should be added to 'autogen-modules'."
 
 
+-- | Note: must be called with the CWD set to the directory containing
+-- the '.cabal' file.
 printPackageProblems :: Verbosity -> PackageDescription -> IO ()
 printPackageProblems verbosity pkg_descr = do
-  ioChecks      <- checkPackageFiles pkg_descr "."
+  ioChecks      <- checkPackageFiles verbosity pkg_descr "."
   let pureChecks = checkConfiguredPackage pkg_descr
       isDistError (PackageDistSuspicious     _) = False
       isDistError (PackageDistSuspiciousWarn _) = False

cabal-install/Distribution/Client/Check.hs

@@ -45,6 +45,8 @@ readGenericPackageDescriptionCheck verbosity fpath = do
             die' verbosity $ "Failed parsing \"" ++ fpath ++ "\"."
         Right x  -> return (warnings, x)
 
+-- | Note: must be called with the CWD set to the directory containing
+-- the '.cabal' file.
 check :: Verbosity -> IO Bool
 check verbosity = do
     pdfile <- defaultPackageDesc verbosity
@@ -66,7 +68,7 @@ check verbosity = do
     --      Hovever, this is the same way hackage does it, so we will yield
     --      the exact same errors as it will.
     let pkg_desc = flattenPackageDescription ppd
-    ioChecks <- checkPackageFiles pkg_desc "."
+    ioChecks <- checkPackageFiles verbosity pkg_desc "."
     let packageChecks = ioChecks ++ checkPackage ppd (Just pkg_desc) ++ ws'
         buildImpossible = [ x | x@PackageBuildImpossible {} <- packageChecks ]
         buildWarning    = [ x | x@PackageBuildWarning {}    <- packageChecks ]

cabal-testsuite/PackageTests/Regression/HadrianT634/pkg/Main.hs

@@ -0,0 +1 @@
+main = putStrLn "Main.hs"

cabal-testsuite/PackageTests/Regression/HadrianT634/pkg/a.cabal

@@ -0,0 +1,9 @@
+cabal-version: 2.2
+name: a
+version: 0
+extra-source-files:
+  doc/*.html
+
+executable foo
+  main-is: Main.hs
+  default-language: Haskell2010

cabal-testsuite/PackageTests/Regression/HadrianT634/pkg/doc/hello.html

@@ -0,0 +1 @@
+hello.html

cabal-testsuite/PackageTests/Regression/HadrianT634/setup.out

@@ -0,0 +1,2 @@
+# Setup configure
+Configuring a-0...

cabal-testsuite/PackageTests/Regression/HadrianT634/setup.test.hs

@@ -0,0 +1,4 @@
+import Test.Cabal.Prelude
+import Test.Cabal.Script
+main = setupTest $
+  void $ setup'' "pkg" "configure" ["--cabal-file", "pkg/a.cabal"]

cabal-testsuite/Test/Cabal/Prelude.hs

@@ -115,7 +115,17 @@ setup :: String -> [String] -> TestM ()
 setup cmd args = void (setup' cmd args)
 
 setup' :: String -> [String] -> TestM Result
-setup' cmd args = do
+setup' = setup'' "."
+
+setup''
+  :: FilePath
+  -- ^ Subdirectory to find the @.cabal@ file in.
+  -> String
+  -- ^ Command name
+  -> [String]
+  -- ^ Arguments
+  -> TestM Result
+setup'' prefix cmd args = do
     env <- getTestEnv
     when ((cmd == "register" || cmd == "copy") && not (testHavePackageDb env)) $
         error "Cannot register/copy without using 'withPackageDb'"
@@ -176,7 +186,7 @@ setup' cmd args = do
                 full_args' = if a `elem` legacyCmds then ("v1-" ++ a) : as else a:as
             in runProgramM cabalProgram full_args'
         else do
-            pdfile <- liftIO $ tryFindPackageDesc (testCurrentDir env)
+            pdfile <- liftIO $ tryFindPackageDesc (testCurrentDir env </> prefix)
             pdesc <- liftIO $ readGenericPackageDescription (testVerbosity env) pdfile
             if buildType (packageDescription pdesc) == Simple
                 then runM (testSetupPath env) full_args
@@ -185,7 +195,7 @@ setup' cmd args = do
                   r <- liftIO $ runghc (testScriptEnv env)
                                        (Just (testCurrentDir env))
                                        (testEnvironment env)
-                                       (testCurrentDir env </> "Setup.hs")
+                                       (testCurrentDir env </> prefix </> "Setup.hs")
                                        full_args
                   recordLog r
                   requireSuccess r