Skip to content

Commit

Permalink
Read basedir from cabal-file, and thread it through apropriately.
Browse files Browse the repository at this point in the history 
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).
  • Loading branch information
@angerman
angerman committed Feb 10, 2018
1 parent 8d88dd9 commit af49513
Show file tree
Hide file tree
Showing 13 changed files with 167 additions and 75 deletions.
110 changes: 76 additions & 34 deletions Cabal/Distribution/Simple.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -100,14 +100,31 @@ import System.Environment (getArgs, getProgName)
import System.Directory (removeFile, doesFileExist
,doesDirectoryExist, removeDirectoryRecursive)
import System.Exit (exitWith,ExitCode(..))
import System.FilePath (searchPathSeparator)
import System.FilePath (searchPathSeparator, takeDirectory, (</>))
import Distribution.Compat.Environment (getEnvironment)
import Distribution.Compat.GetShortPathName (getShortPathName)

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

import Distribution.PackageDescription.Parsec

#if MIN_VERSION_directory(1,2,2)
import System.Directory
(makeAbsolute)
#else
import System.Directory
(getCurrentDirectory)
import System.FilePath
(isAbsolute)

makeAbsolute :: FilePath -> IO FilePath
makeAbsolute p | isAbsolute p = return p
| otherwise = do
cwd <- getCurrentDirectory
return $ cwd </> p
#endif


-- | A simple implementation of @main@ for a Cabal setup script.
-- It reads the package description file using IO, and performs the
-- action specified on the command line.
Expand Down Expand Up @@ -249,9 +266,10 @@ buildAction :: UserHooks -> BuildFlags -> Args -> IO ()
buildAction hooks flags args = do
distPref <- findDistPrefOrDefault (buildDistPref flags)
let verbosity = fromFlag $ buildVerbosity flags
flags' = flags { buildDistPref = toFlag distPref }

lbi <- getBuildConfig hooks verbosity distPref
let flags' = flags { buildDistPref = toFlag distPref
, buildCabalFilePath = maybeToFlag (cabalFilePath lbi)}

progs <- reconfigurePrograms verbosity
(buildProgramPaths flags')
(buildProgramArgs flags')
Expand Down Expand Up @@ -289,7 +307,10 @@ hscolourAction :: UserHooks -> HscolourFlags -> Args -> IO ()
hscolourAction hooks flags args = do
distPref <- findDistPrefOrDefault (hscolourDistPref flags)
let verbosity = fromFlag $ hscolourVerbosity flags
flags' = flags { hscolourDistPref = toFlag distPref }
lbi <- getBuildConfig hooks verbosity distPref
let flags' = flags { hscolourDistPref = toFlag distPref
, hscolourCabalFilePath = maybeToFlag (cabalFilePath lbi)}

hookedAction preHscolour hscolourHook postHscolour
(getBuildConfig hooks verbosity distPref)
hooks flags' args
Expand All @@ -314,9 +335,10 @@ haddockAction :: UserHooks -> HaddockFlags -> Args -> IO ()
haddockAction hooks flags args = do
distPref <- findDistPrefOrDefault (haddockDistPref flags)
let verbosity = fromFlag $ haddockVerbosity flags
flags' = flags { haddockDistPref = toFlag distPref }

lbi <- getBuildConfig hooks verbosity distPref
let flags' = flags { haddockDistPref = toFlag distPref
, haddockCabalFilePath = maybeToFlag (cabalFilePath lbi)}

progs <- reconfigurePrograms verbosity
(haddockProgramPaths flags')
(haddockProgramArgs flags')
Expand Down Expand Up @@ -360,7 +382,9 @@ copyAction :: UserHooks -> CopyFlags -> Args -> IO ()
copyAction hooks flags args = do
distPref <- findDistPrefOrDefault (copyDistPref flags)
let verbosity = fromFlag $ copyVerbosity flags
flags' = flags { copyDistPref = toFlag distPref }
lbi <- getBuildConfig hooks verbosity distPref
let flags' = flags { copyDistPref = toFlag distPref
, copyCabalFilePath = maybeToFlag (cabalFilePath lbi)}
hookedAction preCopy copyHook postCopy
(getBuildConfig hooks verbosity distPref)
hooks flags' { copyArgs = args } args
Expand All @@ -369,7 +393,9 @@ installAction :: UserHooks -> InstallFlags -> Args -> IO ()
installAction hooks flags args = do
distPref <- findDistPrefOrDefault (installDistPref flags)
let verbosity = fromFlag $ installVerbosity flags
flags' = flags { installDistPref = toFlag distPref }
lbi <- getBuildConfig hooks verbosity distPref
let flags' = flags { installDistPref = toFlag distPref
, installCabalFilePath = maybeToFlag (cabalFilePath lbi)}
hookedAction preInst instHook postInst
(getBuildConfig hooks verbosity distPref)
hooks flags' args
Expand Down Expand Up @@ -433,7 +459,9 @@ registerAction :: UserHooks -> RegisterFlags -> Args -> IO ()
registerAction hooks flags args = do
distPref <- findDistPrefOrDefault (regDistPref flags)
let verbosity = fromFlag $ regVerbosity flags
flags' = flags { regDistPref = toFlag distPref }
lbi <- getBuildConfig hooks verbosity distPref
let flags' = flags { regDistPref = toFlag distPref
, regCabalFilePath = maybeToFlag (cabalFilePath lbi)}
hookedAction preReg regHook postReg
(getBuildConfig hooks verbosity distPref)
hooks flags' { regArgs = args } args
Expand All @@ -442,7 +470,9 @@ unregisterAction :: UserHooks -> RegisterFlags -> Args -> IO ()
unregisterAction hooks flags args = do
distPref <- findDistPrefOrDefault (regDistPref flags)
let verbosity = fromFlag $ regVerbosity flags
flags' = flags { regDistPref = toFlag distPref }
lbi <- getBuildConfig hooks verbosity distPref
let flags' = flags { regDistPref = toFlag distPref
, regCabalFilePath = maybeToFlag (cabalFilePath lbi)}
hookedAction preUnreg unregHook postUnreg
(getBuildConfig hooks verbosity distPref)
hooks flags' args
Expand Down Expand Up @@ -630,12 +660,14 @@ defaultUserHooks = autoconfUserHooks {
-- https://github.com/haskell/cabal/issues/158
where oldCompatPostConf args flags pkg_descr lbi
= do let verbosity = fromFlag (configVerbosity flags)
confExists <- doesFileExist "configure"
baseDir lbi' = fromMaybe "" (takeDirectory <$> cabalFilePath lbi')

confExists <- doesFileExist $ (baseDir lbi) </> "configure"
when confExists $
runConfigureScript verbosity
backwardsCompatHack flags lbi

pbi <- getHookedBuildInfo verbosity
pbi <- getHookedBuildInfo (buildDir lbi) verbosity
sanityCheckHookedBuildInfo pkg_descr pbi
let pkg_descr' = updatePackageDescription pbi pkg_descr
lbi' = lbi { localPkgDescr = pkg_descr' }
Expand All @@ -648,44 +680,51 @@ autoconfUserHooks
= simpleUserHooks
{
postConf = defaultPostConf,
preBuild = readHookWithArgs buildVerbosity,
preCopy = readHookWithArgs copyVerbosity,
preClean = readHook cleanVerbosity,
preInst = readHook installVerbosity,
preHscolour = readHook hscolourVerbosity,
preHaddock = readHook haddockVerbosity,
preReg = readHook regVerbosity,
preUnreg = readHook regVerbosity
preBuild = readHookWithArgs buildVerbosity buildDistPref, -- buildCabalFilePath,
preCopy = readHookWithArgs copyVerbosity copyDistPref,
preClean = readHook cleanVerbosity cleanDistPref,
preInst = readHook installVerbosity installDistPref,
preHscolour = readHook hscolourVerbosity hscolourDistPref,
preHaddock = readHook haddockVerbosity haddockDistPref,
preReg = readHook regVerbosity regDistPref,
preUnreg = readHook regVerbosity regDistPref
}
where defaultPostConf :: Args -> ConfigFlags -> PackageDescription
-> LocalBuildInfo -> IO ()
defaultPostConf args flags pkg_descr lbi
= do let verbosity = fromFlag (configVerbosity flags)
confExists <- doesFileExist "configure"
baseDir lbi' = fromMaybe "" (takeDirectory <$> cabalFilePath lbi')
confExists <- doesFileExist $ (baseDir lbi) </> "configure"
if confExists
then runConfigureScript verbosity
backwardsCompatHack flags lbi
else die "configure script not found."

pbi <- getHookedBuildInfo verbosity
pbi <- getHookedBuildInfo (buildDir lbi) verbosity
sanityCheckHookedBuildInfo pkg_descr pbi
let pkg_descr' = updatePackageDescription pbi pkg_descr
lbi' = lbi { localPkgDescr = pkg_descr' }
postConf simpleUserHooks args flags pkg_descr' lbi'

backwardsCompatHack = False

readHookWithArgs :: (a -> Flag Verbosity) -> Args -> a
readHookWithArgs :: (a -> Flag Verbosity)
-> (a -> Flag FilePath)
-> Args -> a
-> IO HookedBuildInfo
readHookWithArgs get_verbosity _ flags = do
getHookedBuildInfo verbosity
readHookWithArgs get_verbosity get_dist_pref _ flags = do
dist_dir <- findDistPrefOrDefault (get_dist_pref flags)
getHookedBuildInfo (dist_dir </> "build") verbosity
where
verbosity = fromFlag (get_verbosity flags)

readHook :: (a -> Flag Verbosity) -> Args -> a -> IO HookedBuildInfo
readHook get_verbosity a flags = do
readHook :: (a -> Flag Verbosity)
-> (a -> Flag FilePath)
-> Args -> a -> IO HookedBuildInfo
readHook get_verbosity get_dist_pref a flags = do
noExtraFlags a
getHookedBuildInfo verbosity
dist_dir <- findDistPrefOrDefault (get_dist_pref flags)
getHookedBuildInfo (dist_dir </> "build") verbosity
where
verbosity = fromFlag (get_verbosity flags)

Expand All @@ -702,6 +741,8 @@ runConfigureScript verbosity backwardsCompatHack flags lbi = do
-- to ccFlags
-- We don't try and tell configure which ld to use, as we don't have
-- a way to pass its flags too
configureFile <- makeAbsolute $
fromMaybe "." (takeDirectory <$> cabalFilePath lbi) </> "configure"
let extraPath = fromNubList $ configProgramPathExtra flags
let cflagsEnv = maybe (unwords ccFlags) (++ (" " ++ unwords ccFlags))
$ lookup "CFLAGS" env
Expand All @@ -710,29 +751,30 @@ runConfigureScript verbosity backwardsCompatHack flags lbi = do
((intercalate spSep extraPath ++ spSep)++) $ lookup "PATH" env
overEnv = ("CFLAGS", Just cflagsEnv) :
[("PATH", Just pathEnv) | not (null extraPath)]
args' = args ++ ["CC=" ++ ccProgShort]
args' = configureFile:args ++ ["CC=" ++ ccProgShort]
shProg = simpleProgram "sh"
progDb = modifyProgramSearchPath
(\p -> map ProgramSearchPathDir extraPath ++ p) emptyProgramDb
shConfiguredProg <- lookupProgram shProg
`fmap` configureProgram verbosity shProg progDb
case shConfiguredProg of
Just sh -> runProgramInvocation verbosity
Just sh -> runProgramInvocation verbosity $
(programInvocation (sh {programOverrideEnv = overEnv}) args')
{ progInvokeCwd = Just (buildDir lbi) }
Nothing -> die notFoundMsg

where
args = "./configure" : configureArgs backwardsCompatHack flags
args = configureArgs backwardsCompatHack flags

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

getHookedBuildInfo :: Verbosity -> IO HookedBuildInfo
getHookedBuildInfo verbosity = do
maybe_infoFile <- defaultHookedPackageDesc
getHookedBuildInfo :: FilePath -> Verbosity -> IO HookedBuildInfo
getHookedBuildInfo build_dir verbosity = do
maybe_infoFile <- findHookedPackageDesc build_dir
case maybe_infoFile of
Nothing -> return emptyHookedBuildInfo
Just infoFile -> do
Expand Down
16 changes: 13 additions & 3 deletions Cabal/Distribution/Simple/Configure.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -124,7 +124,7 @@ import qualified Data.Map as Map
import System.Directory
( doesFileExist, createDirectoryIfMissing, getTemporaryDirectory )
import System.FilePath
( (</>), isAbsolute )
( (</>), isAbsolute, takeDirectory )
import qualified System.Info
( compilerName, compilerVersion )
import System.IO
Expand Down Expand Up @@ -702,6 +702,7 @@ configure (pkg_descr0, pbi) cfg = do
compiler = comp,
hostPlatform = compPlatform,
buildDir = buildDir,
cabalFilePath = flagToMaybe (configCabalFilePath cfg),
componentGraph = Graph.fromDistinctList buildComponents,
componentNameMap = buildComponentsMap,
installedPkgs = packageDependsIndex,
Expand Down Expand Up @@ -1673,14 +1674,23 @@ checkForeignDeps pkg lbi verbosity =

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

baseDir lbi' = fromMaybe "." (takeDirectory <$> cabalFilePath lbi')

commonCppArgs = platformDefines lbi
-- TODO: This is a massive hack, to work around the
-- fact that the test performed here should be
-- PER-component (c.f. the "I'm Feeling Lucky"; we
-- should NOT be glomming everything together.)
++ [ "-I" ++ buildDir lbi </> "autogen" ]
++ [ "-I" ++ dir | dir <- collectField PD.includeDirs ]
++ ["-I."]
-- `configure' may generate headers in the build directory
++ [ "-I" ++ buildDir lbi </> dir | dir <- collectField PD.includeDirs
, not (isAbsolute dir)]
-- we might also reference headers from the packages directory.
++ [ "-I" ++ baseDir lbi </> dir | dir <- collectField PD.includeDirs
, not (isAbsolute dir)]
++ [ "-I" ++ dir | dir <- collectField PD.includeDirs
, isAbsolute dir]
++ ["-I" ++ baseDir lbi]
++ collectField PD.cppOptions
++ collectField PD.ccOptions
++ [ "-I" ++ dir
Expand Down
22 changes: 17 additions & 5 deletions Cabal/Distribution/Simple/GHC/Internal.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -107,8 +107,8 @@ configureToolchain _implInfo ghcProg ghcInfo =
}
where
compilerDir = takeDirectory (programPath ghcProg)
baseDir = takeDirectory compilerDir
mingwBinDir = baseDir </> "mingw" </> "bin"
base_dir = takeDirectory compilerDir
mingwBinDir = base_dir </> "mingw" </> "bin"
isWindows = case buildOS of Windows -> True; _ -> False
binPrefix = ""

Expand Down Expand Up @@ -276,7 +276,11 @@ componentCcGhcOptions verbosity _implInfo lbi bi clbi odir filename =
ghcOptCppIncludePath = toNubListR $ [autogenComponentModulesDir lbi clbi
,autogenPackageModulesDir lbi
,odir]
++ PD.includeDirs bi,
-- includes relative to the package
++ PD.includeDirs bi
-- potential includes generated by `configure'
-- in the build directory
++ [buildDir lbi </> dir | dir <- PD.includeDirs bi],
ghcOptHideAllPackages= toFlag True,
ghcOptPackageDBs = withPackageDB lbi,
ghcOptPackages = toNubListR $ mkGhcOptPackages clbi,
Expand Down Expand Up @@ -309,7 +313,11 @@ componentCxxGhcOptions verbosity _implInfo lbi bi cxxlbi odir filename =
ghcOptCppIncludePath = toNubListR $ [autogenComponentModulesDir lbi cxxlbi
,autogenPackageModulesDir lbi
,odir]
++ PD.includeDirs bi,
-- includes relative to the package
++ PD.includeDirs bi
-- potential includes generated by `configure'
-- in the build directory
++ [buildDir lbi </> dir | dir <- PD.includeDirs bi],
ghcOptHideAllPackages= toFlag True,
ghcOptPackageDBs = withPackageDB lbi,
ghcOptPackages = toNubListR $ mkGhcOptPackages cxxlbi,
Expand Down Expand Up @@ -365,7 +373,11 @@ componentGhcOptions verbosity implInfo lbi bi clbi odir =
ghcOptCppIncludePath = toNubListR $ [autogenComponentModulesDir lbi clbi
,autogenPackageModulesDir lbi
,odir]
++ PD.includeDirs bi,
-- includes relative to the package
++ PD.includeDirs bi
-- potential includes generated by `configure'
-- in the build directory
++ [buildDir lbi </> dir | dir <- PD.includeDirs bi],
ghcOptCppOptions = toNubListR $ cppOptions bi,
ghcOptCppIncludes = toNubListR $
[autogenComponentModulesDir lbi clbi </> cppHeaderName],
Expand Down
3 changes: 2 additions & 1 deletion Cabal/Distribution/Simple/Haddock.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -736,7 +736,8 @@ haddockToHscolour flags =
hscolourBenchmarks = haddockBenchmarks flags,
hscolourForeignLibs = haddockForeignLibs flags,
hscolourVerbosity = haddockVerbosity flags,
hscolourDistPref = haddockDistPref flags
hscolourDistPref = haddockDistPref flags,
hscolourCabalFilePath = haddockCabalFilePath flags
}

-- ------------------------------------------------------------------------------
Expand Down
17 changes: 9 additions & 8 deletions Cabal/Distribution/Simple/Install.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -171,7 +171,7 @@ copyComponent verbosity pkg_descr lbi (CLib lib) clbi copydest = do

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

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

-- | Install the files listed in install-includes for a library
--
installIncludeFiles :: Verbosity -> Library -> FilePath -> FilePath -> IO ()
installIncludeFiles verbosity lib buildPref destIncludeDir = do
let relincdirs = "." : filter isRelative (includeDirs lbi)
lbi = libBuildInfo lib
incdirs = relincdirs ++ [ buildPref </> dir | dir <- relincdirs ]
incs <- traverse (findInc incdirs) (installIncludes lbi)
installIncludeFiles :: Verbosity -> Library -> LocalBuildInfo -> FilePath -> FilePath -> IO ()
installIncludeFiles verbosity lib lbi buildPref destIncludeDir = do
let relincdirs = "." : filter isRelative (includeDirs libBi)
libBi = libBuildInfo lib
incdirs = [ baseDir lbi </> dir | dir <- relincdirs ]
++ [ buildPref </> dir | dir <- relincdirs ]
incs <- traverse (findInc incdirs) (installIncludes libBi)
sequence_
[ do createDirectoryIfMissingVerbose verbosity True destDir
installOrdinaryFile verbosity srcFile destFile
| (relFile, srcFile) <- incs
, let destFile = destIncludeDir </> relFile
destDir = takeDirectory destFile ]
where

baseDir lbi' = fromMaybe "" (takeDirectory <$> cabalFilePath lbi')
findInc [] file = die' verbosity ("can't find include file " ++ file)
findInc (dir:dirs) file = do
let path = dir </> file
Expand Down
Loading

0 comments on commit af49513

Please sign in to comment.