Skip to content

Commit af49513

Browse files
angermanangerman
committed
Read basedir from cabal-file, and thread it through apropriately.
If we have a cabalFilePath, just invoke the configure script there. Otherwise try to invoke it locally to the CWD. But don't try to shell out in a different directory, that would mess up the paths. In general we want to run /path/to/configure from the bulid directory (e.g. outside of the package folder).
1 parent 8d88dd9 commit af49513

File tree

13 files changed

+167
-75
lines changed

13 files changed

+167
-75
lines changed

‎Cabal/Distribution/Simple.hs‎

Lines changed: 76 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -100,14 +100,31 @@ import System.Environment (getArgs, getProgName)
100100
import System.Directory (removeFile, doesFileExist
101101
,doesDirectoryExist, removeDirectoryRecursive)
102102
import System.Exit (exitWith,ExitCode(..))
103-
import System.FilePath (searchPathSeparator)
103+
import System.FilePath (searchPathSeparator, takeDirectory, (</>))
104104
import Distribution.Compat.Environment (getEnvironment)
105105
import Distribution.Compat.GetShortPathName (getShortPathName)
106106

107107
import Data.List (unionBy, (\\))
108108

109109
import Distribution.PackageDescription.Parsec
110110

111+
#if MIN_VERSION_directory(1,2,2)
112+
import System.Directory
113+
(makeAbsolute)
114+
#else
115+
import System.Directory
116+
(getCurrentDirectory)
117+
import System.FilePath
118+
(isAbsolute)
119+
120+
makeAbsolute :: FilePath -> IO FilePath
121+
makeAbsolute p | isAbsolute p = return p
122+
| otherwise = do
123+
cwd <- getCurrentDirectory
124+
return $ cwd </> p
125+
#endif
126+
127+
111128
-- | A simple implementation of @main@ for a Cabal setup script.
112129
-- It reads the package description file using IO, and performs the
113130
-- action specified on the command line.
@@ -249,9 +266,10 @@ buildAction :: UserHooks -> BuildFlags -> Args -> IO ()
249266
buildAction hooks flags args = do
250267
distPref <- findDistPrefOrDefault (buildDistPref flags)
251268
let verbosity = fromFlag $ buildVerbosity flags
252-
flags' = flags { buildDistPref = toFlag distPref }
253-
254269
lbi <- getBuildConfig hooks verbosity distPref
270+
let flags' = flags { buildDistPref = toFlag distPref
271+
, buildCabalFilePath = maybeToFlag (cabalFilePath lbi)}
272+
255273
progs <- reconfigurePrograms verbosity
256274
(buildProgramPaths flags')
257275
(buildProgramArgs flags')
@@ -289,7 +307,10 @@ hscolourAction :: UserHooks -> HscolourFlags -> Args -> IO ()
289307
hscolourAction hooks flags args = do
290308
distPref <- findDistPrefOrDefault (hscolourDistPref flags)
291309
let verbosity = fromFlag $ hscolourVerbosity flags
292-
flags' = flags { hscolourDistPref = toFlag distPref }
310+
lbi <- getBuildConfig hooks verbosity distPref
311+
let flags' = flags { hscolourDistPref = toFlag distPref
312+
, hscolourCabalFilePath = maybeToFlag (cabalFilePath lbi)}
313+
293314
hookedAction preHscolour hscolourHook postHscolour
294315
(getBuildConfig hooks verbosity distPref)
295316
hooks flags' args
@@ -314,9 +335,10 @@ haddockAction :: UserHooks -> HaddockFlags -> Args -> IO ()
314335
haddockAction hooks flags args = do
315336
distPref <- findDistPrefOrDefault (haddockDistPref flags)
316337
let verbosity = fromFlag $ haddockVerbosity flags
317-
flags' = flags { haddockDistPref = toFlag distPref }
318-
319338
lbi <- getBuildConfig hooks verbosity distPref
339+
let flags' = flags { haddockDistPref = toFlag distPref
340+
, haddockCabalFilePath = maybeToFlag (cabalFilePath lbi)}
341+
320342
progs <- reconfigurePrograms verbosity
321343
(haddockProgramPaths flags')
322344
(haddockProgramArgs flags')
@@ -360,7 +382,9 @@ copyAction :: UserHooks -> CopyFlags -> Args -> IO ()
360382
copyAction hooks flags args = do
361383
distPref <- findDistPrefOrDefault (copyDistPref flags)
362384
let verbosity = fromFlag $ copyVerbosity flags
363-
flags' = flags { copyDistPref = toFlag distPref }
385+
lbi <- getBuildConfig hooks verbosity distPref
386+
let flags' = flags { copyDistPref = toFlag distPref
387+
, copyCabalFilePath = maybeToFlag (cabalFilePath lbi)}
364388
hookedAction preCopy copyHook postCopy
365389
(getBuildConfig hooks verbosity distPref)
366390
hooks flags' { copyArgs = args } args
@@ -369,7 +393,9 @@ installAction :: UserHooks -> InstallFlags -> Args -> IO ()
369393
installAction hooks flags args = do
370394
distPref <- findDistPrefOrDefault (installDistPref flags)
371395
let verbosity = fromFlag $ installVerbosity flags
372-
flags' = flags { installDistPref = toFlag distPref }
396+
lbi <- getBuildConfig hooks verbosity distPref
397+
let flags' = flags { installDistPref = toFlag distPref
398+
, installCabalFilePath = maybeToFlag (cabalFilePath lbi)}
373399
hookedAction preInst instHook postInst
374400
(getBuildConfig hooks verbosity distPref)
375401
hooks flags' args
@@ -433,7 +459,9 @@ registerAction :: UserHooks -> RegisterFlags -> Args -> IO ()
433459
registerAction hooks flags args = do
434460
distPref <- findDistPrefOrDefault (regDistPref flags)
435461
let verbosity = fromFlag $ regVerbosity flags
436-
flags' = flags { regDistPref = toFlag distPref }
462+
lbi <- getBuildConfig hooks verbosity distPref
463+
let flags' = flags { regDistPref = toFlag distPref
464+
, regCabalFilePath = maybeToFlag (cabalFilePath lbi)}
437465
hookedAction preReg regHook postReg
438466
(getBuildConfig hooks verbosity distPref)
439467
hooks flags' { regArgs = args } args
@@ -442,7 +470,9 @@ unregisterAction :: UserHooks -> RegisterFlags -> Args -> IO ()
442470
unregisterAction hooks flags args = do
443471
distPref <- findDistPrefOrDefault (regDistPref flags)
444472
let verbosity = fromFlag $ regVerbosity flags
445-
flags' = flags { regDistPref = toFlag distPref }
473+
lbi <- getBuildConfig hooks verbosity distPref
474+
let flags' = flags { regDistPref = toFlag distPref
475+
, regCabalFilePath = maybeToFlag (cabalFilePath lbi)}
446476
hookedAction preUnreg unregHook postUnreg
447477
(getBuildConfig hooks verbosity distPref)
448478
hooks flags' args
@@ -630,12 +660,14 @@ defaultUserHooks = autoconfUserHooks {
630660
-- https://github.com/haskell/cabal/issues/158
631661
where oldCompatPostConf args flags pkg_descr lbi
632662
= do let verbosity = fromFlag (configVerbosity flags)
633-
confExists <- doesFileExist "configure"
663+
baseDir lbi' = fromMaybe "" (takeDirectory <$> cabalFilePath lbi')
664+
665+
confExists <- doesFileExist $ (baseDir lbi) </> "configure"
634666
when confExists $
635667
runConfigureScript verbosity
636668
backwardsCompatHack flags lbi
637669

638-
pbi <- getHookedBuildInfo verbosity
670+
pbi <- getHookedBuildInfo (buildDir lbi) verbosity
639671
sanityCheckHookedBuildInfo pkg_descr pbi
640672
let pkg_descr' = updatePackageDescription pbi pkg_descr
641673
lbi' = lbi { localPkgDescr = pkg_descr' }
@@ -648,44 +680,51 @@ autoconfUserHooks
648680
= simpleUserHooks
649681
{
650682
postConf = defaultPostConf,
651-
preBuild = readHookWithArgs buildVerbosity,
652-
preCopy = readHookWithArgs copyVerbosity,
653-
preClean = readHook cleanVerbosity,
654-
preInst = readHook installVerbosity,
655-
preHscolour = readHook hscolourVerbosity,
656-
preHaddock = readHook haddockVerbosity,
657-
preReg = readHook regVerbosity,
658-
preUnreg = readHook regVerbosity
683+
preBuild = readHookWithArgs buildVerbosity buildDistPref, -- buildCabalFilePath,
684+
preCopy = readHookWithArgs copyVerbosity copyDistPref,
685+
preClean = readHook cleanVerbosity cleanDistPref,
686+
preInst = readHook installVerbosity installDistPref,
687+
preHscolour = readHook hscolourVerbosity hscolourDistPref,
688+
preHaddock = readHook haddockVerbosity haddockDistPref,
689+
preReg = readHook regVerbosity regDistPref,
690+
preUnreg = readHook regVerbosity regDistPref
659691
}
660692
where defaultPostConf :: Args -> ConfigFlags -> PackageDescription
661693
-> LocalBuildInfo -> IO ()
662694
defaultPostConf args flags pkg_descr lbi
663695
= do let verbosity = fromFlag (configVerbosity flags)
664-
confExists <- doesFileExist "configure"
696+
baseDir lbi' = fromMaybe "" (takeDirectory <$> cabalFilePath lbi')
697+
confExists <- doesFileExist $ (baseDir lbi) </> "configure"
665698
if confExists
666699
then runConfigureScript verbosity
667700
backwardsCompatHack flags lbi
668701
else die "configure script not found."
669702

670-
pbi <- getHookedBuildInfo verbosity
703+
pbi <- getHookedBuildInfo (buildDir lbi) verbosity
671704
sanityCheckHookedBuildInfo pkg_descr pbi
672705
let pkg_descr' = updatePackageDescription pbi pkg_descr
673706
lbi' = lbi { localPkgDescr = pkg_descr' }
674707
postConf simpleUserHooks args flags pkg_descr' lbi'
675708

676709
backwardsCompatHack = False
677710

678-
readHookWithArgs :: (a -> Flag Verbosity) -> Args -> a
711+
readHookWithArgs :: (a -> Flag Verbosity)
712+
-> (a -> Flag FilePath)
713+
-> Args -> a
679714
-> IO HookedBuildInfo
680-
readHookWithArgs get_verbosity _ flags = do
681-
getHookedBuildInfo verbosity
715+
readHookWithArgs get_verbosity get_dist_pref _ flags = do
716+
dist_dir <- findDistPrefOrDefault (get_dist_pref flags)
717+
getHookedBuildInfo (dist_dir </> "build") verbosity
682718
where
683719
verbosity = fromFlag (get_verbosity flags)
684720

685-
readHook :: (a -> Flag Verbosity) -> Args -> a -> IO HookedBuildInfo
686-
readHook get_verbosity a flags = do
721+
readHook :: (a -> Flag Verbosity)
722+
-> (a -> Flag FilePath)
723+
-> Args -> a -> IO HookedBuildInfo
724+
readHook get_verbosity get_dist_pref a flags = do
687725
noExtraFlags a
688-
getHookedBuildInfo verbosity
726+
dist_dir <- findDistPrefOrDefault (get_dist_pref flags)
727+
getHookedBuildInfo (dist_dir </> "build") verbosity
689728
where
690729
verbosity = fromFlag (get_verbosity flags)
691730

@@ -702,6 +741,8 @@ runConfigureScript verbosity backwardsCompatHack flags lbi = do
702741
-- to ccFlags
703742
-- We don't try and tell configure which ld to use, as we don't have
704743
-- a way to pass its flags too
744+
configureFile <- makeAbsolute $
745+
fromMaybe "." (takeDirectory <$> cabalFilePath lbi) </> "configure"
705746
let extraPath = fromNubList $ configProgramPathExtra flags
706747
let cflagsEnv = maybe (unwords ccFlags) (++ (" " ++ unwords ccFlags))
707748
$ lookup "CFLAGS" env
@@ -710,29 +751,30 @@ runConfigureScript verbosity backwardsCompatHack flags lbi = do
710751
((intercalate spSep extraPath ++ spSep)++) $ lookup "PATH" env
711752
overEnv = ("CFLAGS", Just cflagsEnv) :
712753
[("PATH", Just pathEnv) | not (null extraPath)]
713-
args' = args ++ ["CC=" ++ ccProgShort]
754+
args' = configureFile:args ++ ["CC=" ++ ccProgShort]
714755
shProg = simpleProgram "sh"
715756
progDb = modifyProgramSearchPath
716757
(\p -> map ProgramSearchPathDir extraPath ++ p) emptyProgramDb
717758
shConfiguredProg <- lookupProgram shProg
718759
`fmap` configureProgram verbosity shProg progDb
719760
case shConfiguredProg of
720-
Just sh -> runProgramInvocation verbosity
761+
Just sh -> runProgramInvocation verbosity $
721762
(programInvocation (sh {programOverrideEnv = overEnv}) args')
763+
{ progInvokeCwd = Just (buildDir lbi) }
722764
Nothing -> die notFoundMsg
723765

724766
where
725-
args = "./configure" : configureArgs backwardsCompatHack flags
767+
args = configureArgs backwardsCompatHack flags
726768

727769
notFoundMsg = "The package has a './configure' script. "
728770
++ "If you are on Windows, This requires a "
729771
++ "Unix compatibility toolchain such as MinGW+MSYS or Cygwin. "
730772
++ "If you are not on Windows, ensure that an 'sh' command "
731773
++ "is discoverable in your path."
732774

733-
getHookedBuildInfo :: Verbosity -> IO HookedBuildInfo
734-
getHookedBuildInfo verbosity = do
735-
maybe_infoFile <- defaultHookedPackageDesc
775+
getHookedBuildInfo :: FilePath -> Verbosity -> IO HookedBuildInfo
776+
getHookedBuildInfo build_dir verbosity = do
777+
maybe_infoFile <- findHookedPackageDesc build_dir
736778
case maybe_infoFile of
737779
Nothing -> return emptyHookedBuildInfo
738780
Just infoFile -> do

‎Cabal/Distribution/Simple/Configure.hs‎

Lines changed: 13 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -124,7 +124,7 @@ import qualified Data.Map as Map
124124
import System.Directory
125125
( doesFileExist, createDirectoryIfMissing, getTemporaryDirectory )
126126
import System.FilePath
127-
( (</>), isAbsolute )
127+
( (</>), isAbsolute, takeDirectory )
128128
import qualified System.Info
129129
( compilerName, compilerVersion )
130130
import System.IO
@@ -702,6 +702,7 @@ configure (pkg_descr0, pbi) cfg = do
702702
compiler = comp,
703703
hostPlatform = compPlatform,
704704
buildDir = buildDir,
705+
cabalFilePath = flagToMaybe (configCabalFilePath cfg),
705706
componentGraph = Graph.fromDistinctList buildComponents,
706707
componentNameMap = buildComponentsMap,
707708
installedPkgs = packageDependsIndex,
@@ -1673,14 +1674,23 @@ checkForeignDeps pkg lbi verbosity =
16731674

16741675
libExists lib = builds (makeProgram []) (makeLdArgs [lib])
16751676

1677+
baseDir lbi' = fromMaybe "." (takeDirectory <$> cabalFilePath lbi')
1678+
16761679
commonCppArgs = platformDefines lbi
16771680
-- TODO: This is a massive hack, to work around the
16781681
-- fact that the test performed here should be
16791682
-- PER-component (c.f. the "I'm Feeling Lucky"; we
16801683
-- should NOT be glomming everything together.)
16811684
++ [ "-I" ++ buildDir lbi </> "autogen" ]
1682-
++ [ "-I" ++ dir | dir <- collectField PD.includeDirs ]
1683-
++ ["-I."]
1685+
-- `configure' may generate headers in the build directory
1686+
++ [ "-I" ++ buildDir lbi </> dir | dir <- collectField PD.includeDirs
1687+
, not (isAbsolute dir)]
1688+
-- we might also reference headers from the packages directory.
1689+
++ [ "-I" ++ baseDir lbi </> dir | dir <- collectField PD.includeDirs
1690+
, not (isAbsolute dir)]
1691+
++ [ "-I" ++ dir | dir <- collectField PD.includeDirs
1692+
, isAbsolute dir]
1693+
++ ["-I" ++ baseDir lbi]
16841694
++ collectField PD.cppOptions
16851695
++ collectField PD.ccOptions
16861696
++ [ "-I" ++ dir

‎Cabal/Distribution/Simple/GHC/Internal.hs‎

Lines changed: 17 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -107,8 +107,8 @@ configureToolchain _implInfo ghcProg ghcInfo =
107107
}
108108
where
109109
compilerDir = takeDirectory (programPath ghcProg)
110-
baseDir = takeDirectory compilerDir
111-
mingwBinDir = baseDir </> "mingw" </> "bin"
110+
base_dir = takeDirectory compilerDir
111+
mingwBinDir = base_dir </> "mingw" </> "bin"
112112
isWindows = case buildOS of Windows -> True; _ -> False
113113
binPrefix = ""
114114

@@ -276,7 +276,11 @@ componentCcGhcOptions verbosity _implInfo lbi bi clbi odir filename =
276276
ghcOptCppIncludePath = toNubListR $ [autogenComponentModulesDir lbi clbi
277277
,autogenPackageModulesDir lbi
278278
,odir]
279-
++ PD.includeDirs bi,
279+
-- includes relative to the package
280+
++ PD.includeDirs bi
281+
-- potential includes generated by `configure'
282+
-- in the build directory
283+
++ [buildDir lbi </> dir | dir <- PD.includeDirs bi],
280284
ghcOptHideAllPackages= toFlag True,
281285
ghcOptPackageDBs = withPackageDB lbi,
282286
ghcOptPackages = toNubListR $ mkGhcOptPackages clbi,
@@ -309,7 +313,11 @@ componentCxxGhcOptions verbosity _implInfo lbi bi cxxlbi odir filename =
309313
ghcOptCppIncludePath = toNubListR $ [autogenComponentModulesDir lbi cxxlbi
310314
,autogenPackageModulesDir lbi
311315
,odir]
312-
++ PD.includeDirs bi,
316+
-- includes relative to the package
317+
++ PD.includeDirs bi
318+
-- potential includes generated by `configure'
319+
-- in the build directory
320+
++ [buildDir lbi </> dir | dir <- PD.includeDirs bi],
313321
ghcOptHideAllPackages= toFlag True,
314322
ghcOptPackageDBs = withPackageDB lbi,
315323
ghcOptPackages = toNubListR $ mkGhcOptPackages cxxlbi,
@@ -365,7 +373,11 @@ componentGhcOptions verbosity implInfo lbi bi clbi odir =
365373
ghcOptCppIncludePath = toNubListR $ [autogenComponentModulesDir lbi clbi
366374
,autogenPackageModulesDir lbi
367375
,odir]
368-
++ PD.includeDirs bi,
376+
-- includes relative to the package
377+
++ PD.includeDirs bi
378+
-- potential includes generated by `configure'
379+
-- in the build directory
380+
++ [buildDir lbi </> dir | dir <- PD.includeDirs bi],
369381
ghcOptCppOptions = toNubListR $ cppOptions bi,
370382
ghcOptCppIncludes = toNubListR $
371383
[autogenComponentModulesDir lbi clbi </> cppHeaderName],

‎Cabal/Distribution/Simple/Haddock.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -736,7 +736,8 @@ haddockToHscolour flags =
736736
hscolourBenchmarks = haddockBenchmarks flags,
737737
hscolourForeignLibs = haddockForeignLibs flags,
738738
hscolourVerbosity = haddockVerbosity flags,
739-
hscolourDistPref = haddockDistPref flags
739+
hscolourDistPref = haddockDistPref flags,
740+
hscolourCabalFilePath = haddockCabalFilePath flags
740741
}
741742

742743
-- ------------------------------------------------------------------------------

‎Cabal/Distribution/Simple/Install.hs‎

Lines changed: 9 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -171,7 +171,7 @@ copyComponent verbosity pkg_descr lbi (CLib lib) clbi copydest = do
171171

172172
-- install include files for all compilers - they may be needed to compile
173173
-- haskell files (using the CPP extension)
174-
installIncludeFiles verbosity lib buildPref incPref
174+
installIncludeFiles verbosity lib lbi buildPref incPref
175175

176176
case compilerFlavor (compiler lbi) of
177177
GHC -> GHC.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr lib clbi
@@ -247,20 +247,21 @@ installDataFiles verbosity pkg_descr destDataDir =
247247

248248
-- | Install the files listed in install-includes for a library
249249
--
250-
installIncludeFiles :: Verbosity -> Library -> FilePath -> FilePath -> IO ()
251-
installIncludeFiles verbosity lib buildPref destIncludeDir = do
252-
let relincdirs = "." : filter isRelative (includeDirs lbi)
253-
lbi = libBuildInfo lib
254-
incdirs = relincdirs ++ [ buildPref </> dir | dir <- relincdirs ]
255-
incs <- traverse (findInc incdirs) (installIncludes lbi)
250+
installIncludeFiles :: Verbosity -> Library -> LocalBuildInfo -> FilePath -> FilePath -> IO ()
251+
installIncludeFiles verbosity lib lbi buildPref destIncludeDir = do
252+
let relincdirs = "." : filter isRelative (includeDirs libBi)
253+
libBi = libBuildInfo lib
254+
incdirs = [ baseDir lbi </> dir | dir <- relincdirs ]
255+
++ [ buildPref </> dir | dir <- relincdirs ]
256+
incs <- traverse (findInc incdirs) (installIncludes libBi)
256257
sequence_
257258
[ do createDirectoryIfMissingVerbose verbosity True destDir
258259
installOrdinaryFile verbosity srcFile destFile
259260
| (relFile, srcFile) <- incs
260261
, let destFile = destIncludeDir </> relFile
261262
destDir = takeDirectory destFile ]
262263
where
263-
264+
baseDir lbi' = fromMaybe "" (takeDirectory <$> cabalFilePath lbi')
264265
findInc [] file = die' verbosity ("can't find include file " ++ file)
265266
findInc (dir:dirs) file = do
266267
let path = dir </> file

0 commit comments

Comments
 (0)