Skip to content

basedir #4874

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 6 commits into from
Feb 14, 2018
Merged

basedir #4874

Show file tree
Hide file tree
Changes from 2 commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
8d88dd9
Adds tryGetBuildInfo
angerman Feb 7, 2018
af49513
Read basedir from cabal-file, and thread it through apropriately.
angerman Nov 7, 2017
3a9830b
Check for duplicate files generated by `configure` and shipped with t…
angerman Feb 8, 2018
767efff
Cleanup directory compat
angerman Feb 8, 2018
3ebb984
Move compat bits for 'directory' to D.Compat.Directory.
23Skidoo Feb 13, 2018
f69ef8d
Comments only.
23Skidoo Feb 13, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
124 changes: 89 additions & 35 deletions Cabal/Distribution/Simple.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -59,6 +59,7 @@ module Distribution.Simple (
) where

import Prelude ()
import Control.Exception (try)
import Distribution.Compat.Prelude

-- local
Expand Down Expand Up @@ -99,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 @@ -248,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 @@ -288,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 @@ -313,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 All @@ -328,7 +351,12 @@ haddockAction hooks flags args = do
cleanAction :: UserHooks -> CleanFlags -> Args -> IO ()
cleanAction hooks flags args = do
distPref <- findDistPrefOrDefault (cleanDistPref flags)
let flags' = flags { cleanDistPref = toFlag distPref }

elbi <- tryGetBuildConfig hooks verbosity distPref
let flags' = flags { cleanDistPref = toFlag distPref
, cleanCabalFilePath = case elbi of
Left _ -> mempty
Right lbi -> maybeToFlag (cabalFilePath lbi)}

pbi <- preClean hooks args flags'

Expand All @@ -354,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 @@ -363,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 @@ -427,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 @@ -436,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 @@ -487,7 +523,13 @@ sanityCheckHookedBuildInfo pkg_descr (_, hookExes)

sanityCheckHookedBuildInfo _ _ = return ()

-- | Try to read the 'localBuildInfoFile'
tryGetBuildConfig :: UserHooks -> Verbosity -> FilePath
Copy link
Member

@23Skidoo 23Skidoo Feb 13, 2018

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Weird, I was quite sure we already had this function somewhere...

-> IO (Either ConfigStateFileError LocalBuildInfo)
tryGetBuildConfig u v = try . getBuildConfig u v


-- | Read the 'localBuildInfoFile' or throw an exception.
getBuildConfig :: UserHooks -> Verbosity -> FilePath -> IO LocalBuildInfo
getBuildConfig hooks verbosity distPref = do
lbi_wo_programs <- getPersistBuildConfig distPref
Expand Down Expand Up @@ -618,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 @@ -636,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
Copy link
Member

@23Skidoo 23Skidoo Feb 13, 2018

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm not totally keen on the fact that we're hardcoding "build" everywhere. This works with new-build directory structure, right?

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 @@ -690,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 @@ -698,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
Copy link
Member

@23Skidoo 23Skidoo Feb 13, 2018

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We should mention in the changelog/migration guide that this function has changed type.

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
Open in desktop
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
Open in desktop
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],
Copy link
Member

@23Skidoo 23Skidoo Feb 14, 2018

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Don't you need to filter out absolute paths here as well?

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
Open in desktop
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
Loading