Commit 693db09d authored by Ryan Scott's avatar Ryan Scott

Fix #5164 by overriding environment variables when new-building custom Setups

parent 59bb50b7
......@@ -35,23 +35,19 @@ import Distribution.Verbosity
import Distribution.Simple.Utils
( wrapText, die', ordNub, info )
import Distribution.Client.ProjectPlanning
( ElaboratedConfiguredPackage(..), BuildStyle(..)
( ElaboratedConfiguredPackage(..)
, ElaboratedInstallPlan, binDirectoryFor )
import Distribution.Client.ProjectPlanning.Types
( dataDirsEnvironmentForPlan )
import Distribution.Client.InstallPlan
( toList, foldPlanPackage )
import Distribution.Types.UnqualComponentName
( UnqualComponentName, unUnqualComponentName )
import Distribution.Types.PackageDescription
( PackageDescription(dataDir) )
import Distribution.Simple.Program.Run
( runProgramInvocation, ProgramInvocation(..),
emptyProgramInvocation )
import Distribution.Simple.Build.PathsModule
( pkgPathEnvVar )
import Distribution.Types.UnitId
( UnitId )
import Distribution.Client.Types
( PackageLocation(..) )
import qualified Data.Map as Map
import qualified Data.Set as Set
......@@ -222,39 +218,6 @@ runAction (configFlags, configExFlags, installFlags, haddockFlags)
globalFlags configFlags configExFlags
installFlags haddockFlags
-- | Construct the environment needed for the data files to work.
-- This consists of a separate @*_datadir@ variable for each
-- inplace package in the plan.
dataDirsEnvironmentForPlan :: ElaboratedInstallPlan
-> [(String, Maybe FilePath)]
dataDirsEnvironmentForPlan = catMaybes
. fmap (foldPlanPackage
(const Nothing)
dataDirEnvVarForPackage)
. toList
-- | Construct an environment variable that points
-- the package's datadir to its correct location.
-- This might be:
-- * 'Just' the package's source directory plus the data subdirectory
-- for inplace packages.
-- * 'Nothing' for packages installed in the store (the path was
-- already included in the package at install/build time).
-- * The other cases are not handled yet. See below.
dataDirEnvVarForPackage :: ElaboratedConfiguredPackage
-> Maybe (String, Maybe FilePath)
dataDirEnvVarForPackage pkg =
case (elabBuildStyle pkg, elabPkgSourceLocation pkg)
of (BuildAndInstall, _) -> Nothing
(BuildInplaceOnly, LocalUnpackedPackage path) -> Just
(pkgPathEnvVar (elabPkgDescription pkg) "datadir",
Just $ path </> dataDir (elabPkgDescription pkg))
-- TODO: handle the other cases for PackageLocation.
-- We will only need this when we add support for
-- remote/local tarballs.
(BuildInplaceOnly, _) -> Nothing
singleExeOrElse :: IO (UnitId, UnqualComponentName) -> TargetsMap -> IO (UnitId, UnqualComponentName)
singleExeOrElse action targetsMap =
case Set.toList . distinctTargetComponents $ targetsMap
......
......@@ -204,6 +204,7 @@ configureSetupScript packageDBs
, useLoggingHandle = Nothing
, useWorkingDir = Nothing
, useExtraPathEnv = []
, useExtraEnvOverrides = []
, setupCacheLock = lock
, useWin32CleanHack = False
, forceExternalSetupMethod = forceExternal
......
......@@ -689,7 +689,7 @@ rebuildTarget verbosity
verbosity distDirLayout storeDirLayout
buildSettings registerLock cacheLock
sharedPackageConfig
rpkg
plan rpkg
srcdir builddir'
where
builddir' = makeRelative srcdir builddir
......@@ -884,6 +884,7 @@ buildAndInstallUnpackedPackage :: Verbosity
-> StoreDirLayout
-> BuildTimeSettings -> Lock -> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> FilePath -> FilePath
-> IO BuildResult
......@@ -902,7 +903,7 @@ buildAndInstallUnpackedPackage verbosity
pkgConfigCompiler = compiler,
pkgConfigCompilerProgs = progdb
}
rpkg@(ReadyPackage pkg)
plan rpkg@(ReadyPackage pkg)
srcdir builddir = do
createDirectoryIfMissingVerbose verbosity True builddir
......@@ -1059,7 +1060,7 @@ buildAndInstallUnpackedPackage verbosity
copyFlags destdir _ = setupHsCopyFlags pkg pkgshared verbosity
builddir destdir
scriptOptions = setupHsScriptOptions rpkg pkgshared srcdir builddir
scriptOptions = setupHsScriptOptions rpkg plan pkgshared srcdir builddir
isParallelBuild cacheLock
setup :: CommandUI flags -> (Version -> flags) -> IO ()
......@@ -1070,7 +1071,9 @@ buildAndInstallUnpackedPackage verbosity
withLogging $ \mLogFileHandle ->
setupWrapper
verbosity
scriptOptions { useLoggingHandle = mLogFileHandle }
scriptOptions
{ useLoggingHandle = mLogFileHandle
, useExtraEnvOverrides = dataDirsEnvironmentForPlan plan }
(Just (elabPkgDescription pkg))
cmd flags args
......@@ -1305,7 +1308,7 @@ buildInplaceUnpackedPackage verbosity
haddockFlags _ = setupHsHaddockFlags pkg pkgshared
verbosity builddir
scriptOptions = setupHsScriptOptions rpkg pkgshared
scriptOptions = setupHsScriptOptions rpkg plan pkgshared
srcdir builddir
isParallelBuild cacheLock
......
......@@ -3020,6 +3020,7 @@ legacyCustomSetupPkgs compiler (Platform _ os) =
-- in the store and local dbs.
setupHsScriptOptions :: ElaboratedReadyPackage
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> FilePath
-> FilePath
......@@ -3029,7 +3030,7 @@ setupHsScriptOptions :: ElaboratedReadyPackage
-- TODO: Fix this so custom is a separate component. Custom can ALWAYS
-- be a separate component!!!
setupHsScriptOptions (ReadyPackage elab@ElaboratedConfiguredPackage{..})
ElaboratedSharedConfig{..} srcdir builddir
plan ElaboratedSharedConfig{..} srcdir builddir
isParallelBuild cacheLock =
SetupScriptOptions {
useCabalVersion = thisVersion elabSetupScriptCliVersion,
......@@ -3048,6 +3049,7 @@ setupHsScriptOptions (ReadyPackage elab@ElaboratedConfiguredPackage{..})
useLoggingHandle = Nothing, -- this gets set later
useWorkingDir = Just srcdir,
useExtraPathEnv = elabExeDependencyPaths elab,
useExtraEnvOverrides = dataDirsEnvironmentForPlan plan,
useWin32CleanHack = False, --TODO: [required eventually]
forceExternalSetupMethod = isParallelBuild,
setupCacheLock = Just cacheLock,
......@@ -3159,7 +3161,7 @@ setupHsConfigureFlags (ReadyPackage elab@ElaboratedConfiguredPackage{..})
configVanillaLib = toFlag elabVanillaLib
configSharedLib = toFlag elabSharedLib
configStaticLib = toFlag elabStaticLib
configDynExe = toFlag elabDynExe
configGHCiLib = toFlag elabGHCiLib
configProfExe = mempty
......
......@@ -23,6 +23,7 @@ module Distribution.Client.ProjectPlanning.Types (
elabPkgConfigDependencies,
elabInplaceDependencyBuildCacheFiles,
elabRequiresRegistration,
dataDirsEnvironmentForPlan,
elabPlanPackageName,
elabConfiguredName,
......@@ -69,12 +70,14 @@ import Distribution.Backpack.ModuleShape
import Distribution.Verbosity
import Distribution.Text
import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.PackageDescription (PackageDescription(..))
import Distribution.Package
hiding (InstalledPackageId, installedPackageId)
import Distribution.System
import qualified Distribution.PackageDescription as Cabal
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import Distribution.Simple.Compiler
import Distribution.Simple.Build.PathsModule (pkgPathEnvVar)
import qualified Distribution.Simple.BuildTarget as Cabal
import Distribution.Simple.Program.Db
import Distribution.ModuleName (ModuleName)
......@@ -91,6 +94,7 @@ import Distribution.Compat.Graph (IsNode(..))
import Distribution.Simple.Utils (ordNub)
import Data.Map (Map)
import Data.Maybe (catMaybes)
import Data.Set (Set)
import qualified Data.ByteString.Lazy as LBS
import Distribution.Compat.Binary
......@@ -98,7 +102,7 @@ import GHC.Generics (Generic)
import qualified Data.Monoid as Mon
import Data.Typeable
import Control.Monad
import System.FilePath ((</>))
-- | The combination of an elaborated install plan plus a
......@@ -337,6 +341,38 @@ elabRequiresRegistration elab =
is_lib (CSubLibName _) = True
is_lib _ = False
-- | Construct the environment needed for the data files to work.
-- This consists of a separate @*_datadir@ variable for each
-- inplace package in the plan.
dataDirsEnvironmentForPlan :: ElaboratedInstallPlan
-> [(String, Maybe FilePath)]
dataDirsEnvironmentForPlan = catMaybes
. fmap (InstallPlan.foldPlanPackage
(const Nothing)
dataDirEnvVarForPackage)
. InstallPlan.toList
-- | Construct an environment variable that points
-- the package's datadir to its correct location.
-- This might be:
-- * 'Just' the package's source directory plus the data subdirectory
-- for inplace packages.
-- * 'Nothing' for packages installed in the store (the path was
-- already included in the package at install/build time).
-- * The other cases are not handled yet. See below.
dataDirEnvVarForPackage :: ElaboratedConfiguredPackage
-> Maybe (String, Maybe FilePath)
dataDirEnvVarForPackage pkg =
case (elabBuildStyle pkg, elabPkgSourceLocation pkg)
of (BuildAndInstall, _) -> Nothing
(BuildInplaceOnly, LocalUnpackedPackage path) -> Just
(pkgPathEnvVar (elabPkgDescription pkg) "datadir",
Just $ path </> dataDir (elabPkgDescription pkg))
-- TODO: handle the other cases for PackageLocation.
-- We will only need this when we add support for
-- remote/local tarballs.
(BuildInplaceOnly, _) -> Nothing
instance Package ElaboratedConfiguredPackage where
packageId = elabPkgSourceId
......
......@@ -86,7 +86,7 @@ import Distribution.Simple.Utils
, copyFileVerbose, rewriteFileEx )
import Distribution.Client.Utils
( inDir, tryCanonicalizePath, withExtraPathEnv
, existsAndIsMoreRecentThan, moreRecentFile, withEnv
, existsAndIsMoreRecentThan, moreRecentFile, withEnv, withEnvOverrides
#ifdef mingw32_HOST_OS
, canonicalizePathNoThrow
#endif
......@@ -185,6 +185,11 @@ data SetupScriptOptions = SetupScriptOptions {
useWorkingDir :: Maybe FilePath,
-- | Extra things to add to PATH when invoking the setup script.
useExtraPathEnv :: [FilePath],
-- | Extra environment variables paired with overrides, where
--
-- * @'Just' v@ means \"set the environment variable's value to @v@\".
-- * 'Nothing' means \"unset the environment variable\".
useExtraEnvOverrides :: [(String, Maybe FilePath)],
forceExternalSetupMethod :: Bool,
-- | List of dependencies to use when building Setup.hs.
......@@ -259,6 +264,7 @@ defaultSetupScriptOptions = SetupScriptOptions {
useLoggingHandle = Nothing,
useWorkingDir = Nothing,
useExtraPathEnv = [],
useExtraEnvOverrides = [],
useWin32CleanHack = False,
forceExternalSetupMethod = False,
setupCacheLock = Nothing,
......@@ -414,7 +420,8 @@ internalSetupMethod verbosity options bt args = do
inDir (useWorkingDir options) $ do
withEnv "HASKELL_DIST_DIR" (useDistPref options) $
withExtraPathEnv (useExtraPathEnv options) $
buildTypeAction bt args
withEnvOverrides (useExtraEnvOverrides options) $
buildTypeAction bt args
buildTypeAction :: BuildType -> ([String] -> IO ())
buildTypeAction Simple = Simple.defaultMainArgs
......@@ -472,8 +479,10 @@ selfExecSetupMethod verbosity options bt args0 = do
searchpath <- programSearchPathAsPATHVar
(map ProgramSearchPathDir (useExtraPathEnv options) ++
getProgramSearchPath (useProgramDb options))
env <- getEffectiveEnvironment [("PATH", Just searchpath)
,("HASKELL_DIST_DIR", Just (useDistPref options))]
env <- getEffectiveEnvironment $
[ ("PATH", Just searchpath)
, ("HASKELL_DIST_DIR", Just (useDistPref options))
] ++ useExtraEnvOverrides options
process <- runProcess' path args
(useWorkingDir options) env Nothing
(useLoggingHandle options) (useLoggingHandle options)
......@@ -505,8 +514,10 @@ externalSetupMethod path verbosity options _ args = do
searchpath <- programSearchPathAsPATHVar
(map ProgramSearchPathDir (useExtraPathEnv options) ++
getProgramSearchPath (useProgramDb options))
env <- getEffectiveEnvironment [("PATH", Just searchpath)
,("HASKELL_DIST_DIR", Just (useDistPref options))]
env <- getEffectiveEnvironment $
[ ("PATH", Just searchpath)
, ("HASKELL_DIST_DIR", Just (useDistPref options))
] ++ useExtraEnvOverrides options
debug verbosity $ "Setup arguments: "++unwords args
process <- runProcess' path' args
......
......@@ -3,8 +3,8 @@
module Distribution.Client.Utils ( MergeResult(..)
, mergeBy, duplicates, duplicatesBy
, readMaybe
, inDir, withEnv, logDirChange
, withExtraPathEnv
, inDir, withEnv, withEnvOverrides
, logDirChange, withExtraPathEnv
, determineNumJobs, numberOfProcessors
, removeExistingFile
, withTempFileName
......@@ -33,6 +33,8 @@ import qualified Data.ByteString.Lazy as BS
import Data.Bits
( (.|.), shiftL, shiftR )
import System.FilePath
import Control.Monad
( mapM, mapM_, zipWithM_ )
import Data.List
( groupBy )
import Foreign.C.Types ( CInt(..) )
......@@ -133,6 +135,27 @@ withEnv k v m = do
Nothing -> unsetEnv k
Just old -> setEnv k old)
-- | Executes the action with a list of environment variables and
-- corresponding overrides, where
--
-- * @'Just' v@ means \"set the environment variable's value to @v@\".
-- * 'Nothing' means \"unset the environment variable\".
--
-- Warning: This operation is NOT thread-safe, because current
-- environment is a process-global concept.
withEnvOverrides :: [(String, Maybe FilePath)] -> IO a -> IO a
withEnvOverrides overrides m = do
mb_olds <- mapM lookupEnv envVars
mapM_ (uncurry update) overrides
m `Exception.finally` zipWithM_ update envVars mb_olds
where
envVars :: [String]
envVars = map fst overrides
update :: String -> Maybe FilePath -> IO ()
update var Nothing = unsetEnv var
update var (Just val) = setEnv var val
-- | Executes the action, increasing the PATH environment
-- in some way
--
......
......@@ -66,6 +66,8 @@
* Paths_ autogen modules now compile when `RebindableSyntax` or
`OverloadedStrings` is used in `default-extensions`.
[stack#3789](https://github.com/commercialhaskell/stack/issues/3789)
* getDataDir` and other `Paths_autogen` functions now work correctly
when compiling a custom `Setup.hs` script using `new-build` (#5164).
2.0.0.1 Mikhail Glushenkov <mikhail.glushenkov@gmail.com> December 2017
* Support for GHC's numeric -g debug levels (#4673).
......
packages: ./setup-lib
./uses-custom-setup
import Test.Cabal.Prelude
main = cabalTest $ do
cabal' "new-build" ["all"] >>= assertOutputContains "Example data file"
module SetupLib (printExampleTxt) where
import Paths_setup_lib
printExampleTxt :: IO ()
printExampleTxt = do
ex <- getDataFileName "example.txt"
exContents <- readFile ex
putStrLn exContents
name: setup-lib
version: 1.0
build-type: Simple
cabal-version: >= 1.10
data-files: example.txt
library
exposed-modules: SetupLib
build-depends: base
default-language: Haskell2010
import Distribution.Simple (defaultMain)
import SetupLib (printExampleTxt)
main :: IO ()
main = do
printExampleTxt
defaultMain
name: uses-custom-setup
version: 1.0
build-type: Custom
cabal-version: >= 1.10
data-files: example.txt
custom-setup
setup-depends: base, Cabal, setup-lib
library
exposed-modules: UsesCustomSetup
build-depends: base
default-language: Haskell2010
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment