Install and use build tools first

This commit is contained in:
Michael Snoyman 2012-12-05 10:50:05 +02:00
parent af5e0104d4
commit 594c88e0a8
5 changed files with 85 additions and 25 deletions

View File

@ -20,6 +20,8 @@ import System.Directory (createDirectoryIfMissing, canonicalizePat
import Distribution.Version (thisVersion, withinRange)
import Control.Exception (assert)
import Data.Set (empty)
import qualified Data.Map as Map
import qualified Data.Set as Set
defaultBuildSettings :: BuildSettings
defaultBuildSettings = BuildSettings
@ -76,7 +78,30 @@ build settings' = do
| v `withinRange` vr -> return ()
| otherwise -> error $ "Unsupported Cabal version: " ++ libVersion
ph <- withBinaryFile "build.log" WriteMode $ \handle ->
menv <- fmap Just $ getModifiedEnv settings
let runCabal args handle = runProcess "cabal" args Nothing menv Nothing (Just handle) (Just handle)
-- First install build tools so they can be used below.
case iiBuildTools ii of
[] -> putStrLn "No build tools required"
tools -> do
putStrLn $ "Installing the following build tools: " ++ unwords tools
ph1 <- withBinaryFile "build-tools.log" WriteMode $ \handle -> do
let args = addCabalArgs settings
$ "install"
: ("--cabal-lib-version=" ++ libVersion)
: "--build-log=logs-tools/$pkg.log"
: "-j"
: iiBuildTools ii
hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args))
runCabal args handle
ec1 <- waitForProcess ph1
unless (ec1 == ExitSuccess) $ do
putStrLn "Building of build tools failed, please see build-tools.log"
exitWith ec1
putStrLn "Build tools built"
ph <- withBinaryFile "build.log" WriteMode $ \handle -> do
let args = addCabalArgs settings
$ "install"
: ("--cabal-lib-version=" ++ libVersion)
@ -87,8 +112,8 @@ build settings' = do
, extraArgs settings
, iiPackageList ii
]
in do hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args))
runProcess "cabal" args Nothing Nothing Nothing (Just handle) (Just handle)
hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args))
runCabal args handle
ec <- waitForProcess ph
unless (ec == ExitSuccess) $ do
putStrLn "Build failed, please see build.log"
@ -99,3 +124,20 @@ build settings' = do
putStrLn "All test suites that were expected to pass did pass, building tarballs."
makeTarballs ii
-- | Get all of the build tools required.
iiBuildTools :: InstallInfo -> [String]
iiBuildTools InstallInfo { iiPackageDB = PackageDB m, iiPackages = packages } =
-- FIXME possible improvement: track the dependencies between the build
-- tools themselves, and install them in the correct order.
map unPackageName
$ filter (flip Map.member m)
$ Set.toList
$ Set.unions
$ map piBuildTools
$ Map.elems
$ Map.filterWithKey isSelected m
where
unPackageName (PackageName pn) = pn
isSelected name _ = name `Set.member` selected
selected = Set.fromList $ Map.keys packages

View File

@ -12,7 +12,7 @@ import Distribution.PackageDescription (condExecutables,
condLibrary,
condTestSuites,
condBenchmarks,
condTreeConstraints, condTreeComponents, ConfVar (..), Condition(..), flagName, flagDefault, genPackageFlags)
condTreeConstraints, condTreeComponents, ConfVar (..), Condition(..), flagName, flagDefault, genPackageFlags, allBuildInfo, packageDescription, buildTools, libBuildInfo, condTreeData, buildInfo, testBuildInfo, benchmarkBuildInfo)
import Distribution.PackageDescription.Parse (ParseResult (ParseOk),
parsePackageDescription)
import Distribution.Version (withinRange)
@ -59,11 +59,12 @@ loadPackageDB core deps = do
_ ->
case Tar.entryContent e of
Tar.NormalFile bs _ -> do
let (deps', hasTests) = parseDeps bs
let (deps', hasTests, buildTools) = parseDeps bs
return $ mappend pdb $ PackageDB $ Map.singleton p PackageInfo
{ piVersion = v
, piDeps = deps'
, piHasTests = hasTests
, piBuildTools = buildTools
}
_ -> return pdb
@ -74,9 +75,19 @@ loadPackageDB core deps = do
, mconcat $ map (go gpd . snd) $ condExecutables gpd
, mconcat $ map (go gpd . snd) $ condTestSuites gpd
, mconcat $ map (go gpd . snd) $ condBenchmarks gpd
], not $ null $ condTestSuites gpd)
_ -> (mempty, defaultHasTestSuites)
], not $ null $ condTestSuites gpd
, Set.fromList $ map depName $ allBuildInfo gpd)
_ -> (mempty, defaultHasTestSuites, Set.empty)
where
allBuildInfo gpd = concat
[ maybe mempty (goBI libBuildInfo) $ condLibrary gpd
, concat $ map (goBI buildInfo . snd) $ condExecutables gpd
, concat $ map (goBI testBuildInfo . snd) $ condTestSuites gpd
, concat $ map (goBI benchmarkBuildInfo . snd) $ condBenchmarks gpd
]
where
goBI f x = buildTools $ f $ condTreeData x
depName (Dependency p _) = p
go gpd tree
= Set.unions
$ Set.fromList (map (\(Dependency p _) -> p) $ condTreeConstraints tree)

View File

@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Stackage.Test
( runTestSuites
@ -32,18 +31,6 @@ runTestSuites settings ii = do
hasTestSuites name = maybe defaultHasTestSuites piHasTests $ Map.lookup name pdb
-- | Separate for the PATH environment variable
pathSep :: Char
#ifdef mingw32_HOST_OS
pathSep = ';'
#else
pathSep = ':'
#endif
fixEnv :: FilePath -> (String, String) -> (String, String)
fixEnv bin (p@"PATH", x) = (p, bin ++ pathSep : x)
fixEnv _ x = x
data TestException = TestException
deriving (Show, Typeable)
instance Exception TestException
@ -56,11 +43,11 @@ runTestSuite :: BuildSettings
-> IO Bool
runTestSuite settings testdir hasTestSuites prevPassed (packageName, (version, Maintainer maintainer)) = do
-- Set up a new environment that includes the sandboxed bin folder in PATH.
env' <- getEnvironment
env' <- getModifiedEnv settings
let menv addGPP
= Just $ (if addGPP then (("GHC_PACKAGE_PATH", packageDir settings ++ ":"):) else id)
$ ("HASKELL_PACKAGE_SANDBOX", packageDir settings)
: map (fixEnv $ binDir settings) env'
: env'
let runGen addGPP cmd args wdir handle = do
ph <- runProcess cmd args (Just wdir) (menv addGPP) Nothing (Just handle) (Just handle)

View File

@ -25,9 +25,10 @@ instance Monoid PackageDB where
| otherwise = pi2
data PackageInfo = PackageInfo
{ piVersion :: Version
, piDeps :: Set PackageName
, piHasTests :: Bool
{ piVersion :: Version
, piDeps :: Set PackageName
, piHasTests :: Bool
, piBuildTools :: Set PackageName
}
deriving (Show, Eq, Ord)

View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
module Stackage.Util where
import qualified Codec.Archive.Tar as Tar
@ -14,6 +15,7 @@ import System.Directory (doesDirectoryExist,
removeDirectoryRecursive)
import System.Directory (getAppUserDataDirectory)
import System.FilePath ((</>))
import System.Environment (getEnvironment)
identsToRanges :: Set PackageIdentifier -> Map PackageName (VersionRange, Maintainer)
identsToRanges =
@ -84,3 +86,20 @@ addCabalArgs settings rest
: ("--datadir=" ++ dataDir settings)
: ("--docdir=" ++ docDir settings)
: extraArgs settings ++ rest
-- | Modified environment that adds our sandboxed bin folder to PATH.
getModifiedEnv :: BuildSettings -> IO [(String, String)]
getModifiedEnv settings = do
fmap (map $ fixEnv $ binDir settings) getEnvironment
where
fixEnv :: FilePath -> (String, String) -> (String, String)
fixEnv bin (p@"PATH", x) = (p, bin ++ pathSep : x)
fixEnv _ x = x
-- | Separate for the PATH environment variable
pathSep :: Char
#ifdef mingw32_HOST_OS
pathSep = ';'
#else
pathSep = ':'
#endif