Allow a directory of replacement tarballs

This commit is contained in:
Michael Snoyman 2013-06-30 13:31:36 +03:00
parent bbec9acf5d
commit 574ba0ba04
4 changed files with 24 additions and 8 deletions

View File

@ -25,6 +25,7 @@ defaultBuildSettings version = BuildSettings
, extraArgs = const ["-fnetwork23"] , extraArgs = const ["-fnetwork23"]
, testWorkerThreads = 4 , testWorkerThreads = 4
, buildDocs = True , buildDocs = True
, tarballDir = "patching/tarballs"
} }
build :: BuildSettings -> BuildPlan -> IO () build :: BuildSettings -> BuildPlan -> IO ()
@ -72,6 +73,7 @@ build settings' bp = do
putStrLn "Beginning Stackage build" putStrLn "Beginning Stackage build"
ph <- withBinaryFile "build.log" WriteMode $ \handle -> do ph <- withBinaryFile "build.log" WriteMode $ \handle -> do
packageList <- mapM (replaceTarball settings) $ bpPackageList bp
let args = addCabalArgs settings BSBuild let args = addCabalArgs settings BSBuild
$ "install" $ "install"
: ("--cabal-lib-version=" ++ libVersion) : ("--cabal-lib-version=" ++ libVersion)
@ -79,9 +81,7 @@ build settings' bp = do
: "--max-backjumps=-1" : "--max-backjumps=-1"
: "--reorder-goals" : "--reorder-goals"
: "-j" : "-j"
: concat : packageList
[ bpPackageList bp
]
hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args)) hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args))
runCabal args handle runCabal args handle
ec <- waitForProcess ph ec <- waitForProcess ph

View File

@ -97,7 +97,8 @@ runTestSuite settings testdir (packageName, SelectedPackageInfo {..}) = do
runGhcPackagePath = runGen True runGhcPackagePath = runGen True
passed <- handle (\TestException -> return False) $ do passed <- handle (\TestException -> return False) $ do
getHandle WriteMode $ run "cabal" ["unpack", package] testdir package' <- replaceTarball settings package
getHandle WriteMode $ run "cabal" ["unpack", package'] testdir
getHandle AppendMode $ run "cabal" (addCabalArgs settings BSTest ["configure", "--enable-tests"]) dir getHandle AppendMode $ run "cabal" (addCabalArgs settings BSTest ["configure", "--enable-tests"]) dir
when spiHasTests $ do when spiHasTests $ do
getHandle AppendMode $ run "cabal" ["build"] dir getHandle AppendMode $ run "cabal" ["build"] dir

View File

@ -132,6 +132,8 @@ data BuildSettings = BuildSettings
-- ^ How many threads to spawn for running test suites. -- ^ How many threads to spawn for running test suites.
, buildDocs :: Bool , buildDocs :: Bool
-- ^ Build docs as part of the test procedure. -- ^ Build docs as part of the test procedure.
, tarballDir :: FilePath
-- ^ Directory containing replacement tarballs.
} }
-- | A wrapper around a @Map@ providing a better @Monoid@ instance. -- | A wrapper around a @Map@ providing a better @Monoid@ instance.

View File

@ -18,11 +18,11 @@ import Distribution.Version (thisVersion)
import Stackage.Types import Stackage.Types
import System.Directory (doesDirectoryExist, import System.Directory (doesDirectoryExist,
removeDirectoryRecursive) removeDirectoryRecursive)
import System.Directory (getAppUserDataDirectory) import System.Directory (getAppUserDataDirectory
import System.Directory (canonicalizePath, ,canonicalizePath,
createDirectoryIfMissing) createDirectoryIfMissing, doesFileExist)
import System.Environment (getEnvironment) import System.Environment (getEnvironment)
import System.FilePath ((</>)) import System.FilePath ((</>), (<.>))
-- | Allow only packages with permissive licenses. -- | Allow only packages with permissive licenses.
allowPermissive :: [String] -- ^ list of explicitly allowed packages allowPermissive :: [String] -- ^ list of explicitly allowed packages
@ -148,3 +148,16 @@ fixBuildSettings settings' = do
createDirectoryIfMissing True root' createDirectoryIfMissing True root'
root <- canonicalizePath root' root <- canonicalizePath root'
return settings' { sandboxRoot = root } return settings' { sandboxRoot = root }
-- | Check if a tarball exists in the tarball directory and, if so, use that
-- instead of the given name.
replaceTarball :: BuildSettings
-> String
-> IO String
replaceTarball bs pkgname = do
exists <- doesFileExist fp
if exists
then canonicalizePath fp
else return pkgname
where
fp = tarballDir bs </> pkgname <.> "tar.gz"