on master help sign in
BuildSettings
commitac709e93b4d1e12df072233fbd64a1344c0e9f25 authorMichael Snoyman <michael@snoyman.com> dateThu 29 Nov 2012, 16:37 (14 years ago) parentecc9ceb
8 files changed+68−52
Stackage/Build.hs+28−13 Stackage/CheckPlan.hs+3−3 Stackage/Config.hs+6−14 Stackage/InstallInfo.hs+4−4 Stackage/Test.hs+8−8 Stackage/Types.hs+9 Stackage/Util.hs+8−8 app/stackage.hs+2−2
Stackage/Build.hs+28−13
@@ -1,14 +1,18 @@
11module Stackage.Build
22 ( build
3+ , defaultBuildSettings
4+ , BuildSettings (..)
35 ) where
46
57import Distribution.Text (simpleParse)
68import Control.Monad (unless)
9+import Stackage.Types
710import Stackage.CheckPlan
811import Stackage.InstallInfo
912import Stackage.Tarballs
1013import Stackage.Test
1114import Stackage.Util
15+import Stackage.Config
1216import System.Exit (ExitCode (ExitSuccess), exitWith)
1317import System.IO (IOMode (WriteMode), withBinaryFile)
1418import System.Process (runProcess, waitForProcess, rawSystem, readProcess)
@@ -16,27 +20,35 @@ import System.Directory (createDirectoryIfMissing, canonicalizePat
1620import Distribution.Version (thisVersion, withinRange)
1721import Control.Exception (assert)
1822
19−build :: FilePath
20− -> ([String] -> [String]) -- ^ extra build rgs
21− -> IO ()
22−build root' extraBuildArgs = do
23+defaultBuildSettings :: BuildSettings
24+defaultBuildSettings = BuildSettings
25+ { sandboxRoot = "sandbox"
26+ , extraBuildArgs = []
27+ , extraCore = defaultExtraCore
28+ , expectedFailures = defaultExpectedFailures
29+ , stablePackages = defaultStablePackages
30+ , extraArgs = ["-fnetwork23"]
31+ }
32+
33+build :: BuildSettings -> IO ()
34+build settings' = do
2335 putStrLn "Creating a build plan"
24− ii <- getInstallInfo
36+ ii <- getInstallInfo settings'
2537
2638 putStrLn "Wiping out old sandbox folder"
39+ let root' = sandboxRoot settings'
2740 rm_r root'
2841 rm_r "logs"
2942 createDirectoryIfMissing True root'
3043 root <- canonicalizePath root'
44+ let settings = settings' { sandboxRoot = root }
3145
32− ec1 <- rawSystem "ghc-pkg" ["init", packageDir root]
46+ ec1 <- rawSystem "ghc-pkg" ["init", packageDir settings]
3347 unless (ec1 == ExitSuccess) $ do
3448 putStrLn "Unable to create package database via ghc-pkg init"
3549 exitWith ec1
3650
37− let extraArgs = ("-fnetwork23":)
38−
39− checkPlan (addCabalArgs root . extraArgs) ii
51+ checkPlan settings ii
4052 putStrLn "No mismatches, starting the sandboxed build."
4153
4254 versionString <- readProcess "cabal" ["--version"] ""
@@ -53,13 +65,16 @@ build root' extraBuildArgs = do
5365 | otherwise -> error $ "Unsupported Cabal version: " ++ libVersion
5466
5567 ph <- withBinaryFile "build.log" WriteMode $ \handle ->
56− let args = addCabalArgs root
68+ let args = addCabalArgs settings
5769 $ "install"
5870 : ("--cabal-lib-version=" ++ libVersion)
5971 : "--build-log=logs/$pkg.log"
60− : "--enable-shared"
6172 : "-j"
62− : (extraBuildArgs . extraArgs) (iiPackageList ii)
73+ : concat
74+ [ extraBuildArgs settings
75+ , extraArgs settings
76+ , iiPackageList ii
77+ ]
6378 in runProcess "cabal" args Nothing Nothing Nothing (Just handle) (Just handle)
6479 ec <- waitForProcess ph
6580 unless (ec == ExitSuccess) $ do
@@ -67,7 +82,7 @@ build root' extraBuildArgs = do
6782 exitWith ec
6883
6984 putStrLn "Sandbox built, beginning individual test suites"
70− runTestSuites root ii
85+ runTestSuites settings ii
7186
7287 putStrLn "All test suites that were expected to pass did pass, building tarballs."
7388 makeTarballs ii
Stackage/CheckPlan.hs+3−3
@@ -16,9 +16,9 @@ import System.Process (readProcessWithExitCode)
1616data Mismatch = OnlyDryRun String | OnlySimpleList String
1717 deriving Show
1818
19−checkPlan :: ([String] -> [String]) -> InstallInfo -> IO ()
20−checkPlan extraArgs ii = do
21− (ec, dryRun', stderr) <- readProcessWithExitCode "cabal" (extraArgs $ "install":"--dry-run":iiPackageList ii) ""
19+checkPlan :: BuildSettings -> InstallInfo -> IO ()
20+checkPlan settings ii = do
21+ (ec, dryRun', stderr) <- readProcessWithExitCode "cabal" (addCabalArgs settings $ "install":"--dry-run":iiPackageList ii) ""
2222 when (ec /= ExitSuccess || "Warning:" `isPrefixOf` stderr) $ do
2323 putStr stderr
2424 putStr dryRun'
Stackage/Config.hs+6−14
@@ -15,14 +15,14 @@ targetCompilerVersion =
1515
1616-- | Packages which are shipped with GHC but are not included in the
1717-- Haskell Platform list of core packages.
18−extraCore :: Set PackageName
19−extraCore = singleton $ PackageName "binary"
18+defaultExtraCore :: Set PackageName
19+defaultExtraCore = singleton $ PackageName "binary"
2020
2121-- | Test suites which are expected to fail for some reason. The test suite
2222-- will still be run and logs kept, but a failure will not indicate an
2323-- error in our package combination.
24−expectedFailures :: Set PackageName
25−expectedFailures = fromList $ map PackageName
24+defaultExpectedFailures :: Set PackageName
25+defaultExpectedFailures = fromList $ map PackageName
2626 [ -- Requires an old version of WAI and Warp for tests
2727 "HTTP"
2828 -- Requires a special hspec-meta which is not yet available from
@@ -58,8 +58,8 @@ expectedFailures = fromList $ map PackageName
5858-- | List of packages for our stable Hackage. All dependencies will be
5959-- included as well. Please indicate who will be maintaining the package
6060-- via comments.
61−stablePackages :: Map PackageName (VersionRange, Maintainer)
62−stablePackages = execWriter $ do
61+defaultStablePackages :: Map PackageName (VersionRange, Maintainer)
62+defaultStablePackages = execWriter $ do
6363 mapM_ (add "michael@snoyman.com") $ words
6464 "yesod yesod-newsfeed yesod-sitemap yesod-static yesod-test markdown filesystem-conduit mime-mail-ses"
6565
@@ -80,11 +80,3 @@ stablePackages = execWriter $ do
8080 case simpleParse range of
8181 Nothing -> error $ "Invalid range " ++ show range ++ " for " ++ package
8282 Just range' -> tell $ Map.singleton (PackageName package) (range', Maintainer maintainer)
83−
84−verbose :: Bool
85−verbose =
86−#if VERBOSE
87− True
88−#else
89− False
90−#endif
Stackage/InstallInfo.hs+4−4
@@ -13,11 +13,11 @@ import Stackage.Types
1313import Stackage.Util
1414import Data.Version (showVersion)
1515
16−getInstallInfo :: IO InstallInfo
17−getInstallInfo = do
16+getInstallInfo :: BuildSettings -> IO InstallInfo
17+getInstallInfo settings = do
1818 hp <- loadHaskellPlatform
19− let allPackages = Map.union stablePackages $ identsToRanges (hplibs hp)
20− let totalCore = extraCore `Set.union` Set.map (\(PackageIdentifier p _) -> p) (hpcore hp)
19+ let allPackages = Map.union (stablePackages settings) $ identsToRanges (hplibs hp)
20+ let totalCore = extraCore settings `Set.union` Set.map (\(PackageIdentifier p _) -> p) (hpcore hp)
2121 pdb <- loadPackageDB totalCore allPackages
2222 final <- narrowPackageDB pdb $ Set.fromList $ Map.toList $ Map.map snd $ allPackages
2323
Stackage/Test.hs+8−8
@@ -20,12 +20,12 @@ import System.Process (runProcess, waitForProcess)
2020import Control.Exception (handle, Exception, throwIO)
2121import Data.Typeable (Typeable)
2222
23−runTestSuites :: FilePath -> InstallInfo -> IO ()
24−runTestSuites root ii = do
23+runTestSuites :: BuildSettings -> InstallInfo -> IO ()
24+runTestSuites settings ii = do
2525 let testdir = "runtests"
2626 rm_r testdir
2727 createDirectory testdir
28− allPass <- foldM (runTestSuite root testdir hasTestSuites) True $ Map.toList $ iiPackages ii
28+ allPass <- foldM (runTestSuite settings testdir hasTestSuites) True $ Map.toList $ iiPackages ii
2929 unless allPass $ error $ "There were failures, please see the logs in " ++ testdir
3030 where
3131 PackageDB pdb = iiPackageDB ii
@@ -48,16 +48,16 @@ data TestException = TestException
4848 deriving (Show, Typeable)
4949instance Exception TestException
5050
51−runTestSuite :: FilePath
51+runTestSuite :: BuildSettings
5252 -> FilePath
5353 -> (PackageName -> Bool) -- ^ do we have any test suites?
5454 -> Bool
5555 -> (PackageName, (Version, Maintainer))
5656 -> IO Bool
57−runTestSuite root testdir hasTestSuites prevPassed (packageName, (version, Maintainer maintainer)) = do
57+runTestSuite settings testdir hasTestSuites prevPassed (packageName, (version, Maintainer maintainer)) = do
5858 -- Set up a new environment that includes the sandboxed bin folder in PATH.
5959 env' <- getEnvironment
60− let menv = Just $ map (fixEnv $ binDir root) env'
60+ let menv = Just $ map (fixEnv $ binDir settings) env'
6161
6262 let run cmd args wdir handle = do
6363 ph <- runProcess cmd args (Just wdir) menv Nothing (Just handle) (Just handle)
@@ -66,13 +66,13 @@ runTestSuite root testdir hasTestSuites prevPassed (packageName, (version, Maint
6666
6767 passed <- handle (\TestException -> return False) $ do
6868 getHandle WriteMode $ run "cabal" ["unpack", package] testdir
69− getHandle AppendMode $ run "cabal" (addCabalArgs root ["configure", "--enable-tests"]) dir
69+ getHandle AppendMode $ run "cabal" (addCabalArgs settings ["configure", "--enable-tests"]) dir
7070 when (hasTestSuites packageName) $ do
7171 getHandle AppendMode $ run "cabal" ["build"] dir
7272 getHandle AppendMode $ run "cabal" ["test"] dir
7373 getHandle AppendMode $ run "cabal" ["haddock"] dir
7474 return True
75− let expectedFailure = packageName `Set.member` expectedFailures
75+ let expectedFailure = packageName `Set.member` expectedFailures settings
7676 if passed
7777 then do
7878 removeFile logfile
Stackage/Types.hs+9
@@ -53,3 +53,12 @@ data InstallInfo = InstallInfo
5353-- | Email address of a Stackage maintainer.
5454newtype Maintainer = Maintainer { unMaintainer :: String }
5555 deriving (Show, Eq, Ord)
56+
57+data BuildSettings = BuildSettings
58+ { sandboxRoot :: FilePath
59+ , extraBuildArgs :: [String]
60+ , extraCore :: Set PackageName
61+ , expectedFailures :: Set PackageName
62+ , stablePackages :: Map PackageName (VersionRange, Maintainer)
63+ , extraArgs :: [String]
64+ }
Stackage/Util.hs+8−8
@@ -69,14 +69,14 @@ getPackageVersion e = do
6969defaultHasTestSuites :: Bool
7070defaultHasTestSuites = True
7171
72−packageDir = (</> "package-db")
73−libDir = (</> "lib")
74−binDir = (</> "bin")
72+packageDir = (</> "package-db") . sandboxRoot
73+libDir = (</> "lib") . sandboxRoot
74+binDir = (</> "bin") . sandboxRoot
7575
76−addCabalArgs root rest
76+addCabalArgs settings rest
7777 = "--package-db=clear"
7878 : "--package-db=global"
79− : ("--package-db=" ++ packageDir root)
80− : ("--libdir=" ++ libDir root)
81− : ("--bindir=" ++ binDir root)
82− : rest
79+ : ("--package-db=" ++ packageDir settings)
80+ : ("--libdir=" ++ libDir settings)
81+ : ("--bindir=" ++ binDir settings)
82+ : extraArgs settings ++ rest
app/stackage.hs+2−2
@@ -1,4 +1,4 @@
1−import Stackage.Build (build)
1+import Stackage.Build (build, defaultBuildSettings)
22import Stackage.Init (stackageInit)
33import System.Environment (getArgs, getProgName)
44
@@ -6,7 +6,7 @@ main :: IO ()
66main = do
77 args <- getArgs
88 case args of
9− ["build"] -> build "sandbox" id
9+ ["build"] -> build defaultBuildSettings
1010 ["init"] -> stackageInit
1111 ["update"] -> stackageInit >> error "FIXME update"
1212 _ -> do