mirror of
https://github.com/commercialhaskell/stackage.git
synced 2026-01-11 23:08:30 +01:00
Install and use build tools first
This commit is contained in:
parent
af5e0104d4
commit
594c88e0a8
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user