From 594c88e0a8b912b75919994eeb55ec111fd29003 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Wed, 5 Dec 2012 10:50:05 +0200 Subject: [PATCH] Install and use build tools first --- Stackage/Build.hs | 48 +++++++++++++++++++++++++++++++++++++--- Stackage/LoadDatabase.hs | 19 ++++++++++++---- Stackage/Test.hs | 17 ++------------ Stackage/Types.hs | 7 +++--- Stackage/Util.hs | 19 ++++++++++++++++ 5 files changed, 85 insertions(+), 25 deletions(-) diff --git a/Stackage/Build.hs b/Stackage/Build.hs index cb912003..cd4af469 100644 --- a/Stackage/Build.hs +++ b/Stackage/Build.hs @@ -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 diff --git a/Stackage/LoadDatabase.hs b/Stackage/LoadDatabase.hs index d71b161c..5280aa1e 100644 --- a/Stackage/LoadDatabase.hs +++ b/Stackage/LoadDatabase.hs @@ -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) diff --git a/Stackage/Test.hs b/Stackage/Test.hs index 98627360..6a89c80f 100644 --- a/Stackage/Test.hs +++ b/Stackage/Test.hs @@ -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) diff --git a/Stackage/Types.hs b/Stackage/Types.hs index e8e3f236..e30c1384 100644 --- a/Stackage/Types.hs +++ b/Stackage/Types.hs @@ -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) diff --git a/Stackage/Util.hs b/Stackage/Util.hs index 12f9d9d9..1784dbef 100644 --- a/Stackage/Util.hs +++ b/Stackage/Util.hs @@ -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