git.iko.soy/stackage
on master help sign in
BuildSettings
ac709e9Michael Snoyman
Stackage/Build.hs+28−13
compare with master
unifiedsplit
@@ -1,14 +1,18 @@
1module Stackage.Build
1module Stackage.Build
2 ( build
2 ( build
3+ , defaultBuildSettings
4+ , BuildSettings (..)
3 ) where
5 ) where
4
6
5import Distribution.Text (simpleParse)
7import Distribution.Text (simpleParse)
6import Control.Monad (unless)
8import Control.Monad (unless)
9+import Stackage.Types
7import Stackage.CheckPlan
10import Stackage.CheckPlan
8import Stackage.InstallInfo
11import Stackage.InstallInfo
9import Stackage.Tarballs
12import Stackage.Tarballs
10import Stackage.Test
13import Stackage.Test
11import Stackage.Util
14import Stackage.Util
15+import Stackage.Config
12import System.Exit (ExitCode (ExitSuccess), exitWith)
16import System.Exit (ExitCode (ExitSuccess), exitWith)
13import System.IO (IOMode (WriteMode), withBinaryFile)
17import System.IO (IOMode (WriteMode), withBinaryFile)
14import System.Process (runProcess, waitForProcess, rawSystem, readProcess)
18import System.Process (runProcess, waitForProcess, rawSystem, readProcess)
@@ -16,27 +20,35 @@ import System.Directory (createDirectoryIfMissing, canonicalizePat
16import Distribution.Version (thisVersion, withinRange)
20import Distribution.Version (thisVersion, withinRange)
17import Control.Exception (assert)
21import Control.Exception (assert)
18
22
19−build :: FilePath
23+defaultBuildSettings :: BuildSettings
20− -> ([String] -> [String]) -- ^ extra build rgs
24+defaultBuildSettings = BuildSettings
21− -> IO ()
25+ { sandboxRoot = "sandbox"
22−build root' extraBuildArgs = do
26+ , extraBuildArgs = []
27+ , extraCore = defaultExtraCore
28+ , expectedFailures = defaultExpectedFailures
29+ , stablePackages = defaultStablePackages
30+ , extraArgs = ["-fnetwork23"]
31+ }
32+
33+build :: BuildSettings -> IO ()
34+build settings' = do
23 putStrLn "Creating a build plan"
35 putStrLn "Creating a build plan"
24− ii <- getInstallInfo
36+ ii <- getInstallInfo settings'
25
37
26 putStrLn "Wiping out old sandbox folder"
38 putStrLn "Wiping out old sandbox folder"
39+ let root' = sandboxRoot settings'
27 rm_r root'
40 rm_r root'
28 rm_r "logs"
41 rm_r "logs"
29 createDirectoryIfMissing True root'
42 createDirectoryIfMissing True root'
30 root <- canonicalizePath root'
43 root <- canonicalizePath root'
44+ let settings = settings' { sandboxRoot = root }
31
45
32− ec1 <- rawSystem "ghc-pkg" ["init", packageDir root]
46+ ec1 <- rawSystem "ghc-pkg" ["init", packageDir settings]
33 unless (ec1 == ExitSuccess) $ do
47 unless (ec1 == ExitSuccess) $ do
34 putStrLn "Unable to create package database via ghc-pkg init"
48 putStrLn "Unable to create package database via ghc-pkg init"
35 exitWith ec1
49 exitWith ec1
36
50
37− let extraArgs = ("-fnetwork23":)
38−
39− checkPlan (addCabalArgs root . extraArgs) ii
51+ checkPlan settings ii
40 putStrLn "No mismatches, starting the sandboxed build."
52 putStrLn "No mismatches, starting the sandboxed build."
41
53
42 versionString <- readProcess "cabal" ["--version"] ""
54 versionString <- readProcess "cabal" ["--version"] ""
@@ -53,13 +65,16 @@ build root' extraBuildArgs = do
53 | otherwise -> error $ "Unsupported Cabal version: " ++ libVersion
65 | otherwise -> error $ "Unsupported Cabal version: " ++ libVersion
54
66
55 ph <- withBinaryFile "build.log" WriteMode $ \handle ->
67 ph <- withBinaryFile "build.log" WriteMode $ \handle ->
56− let args = addCabalArgs root
68+ let args = addCabalArgs settings
57 $ "install"
69 $ "install"
58 : ("--cabal-lib-version=" ++ libVersion)
70 : ("--cabal-lib-version=" ++ libVersion)
59 : "--build-log=logs/$pkg.log"
71 : "--build-log=logs/$pkg.log"
60− : "--enable-shared"
61 : "-j"
72 : "-j"
73+ : concat
74+ [ extraBuildArgs settings
75+ , extraArgs settings
62− : (extraBuildArgs . extraArgs) (iiPackageList ii)
76+ , iiPackageList ii
77+ ]
63 in runProcess "cabal" args Nothing Nothing Nothing (Just handle) (Just handle)
78 in runProcess "cabal" args Nothing Nothing Nothing (Just handle) (Just handle)
64 ec <- waitForProcess ph
79 ec <- waitForProcess ph
65 unless (ec == ExitSuccess) $ do
80 unless (ec == ExitSuccess) $ do
@@ -67,7 +82,7 @@ build root' extraBuildArgs = do
67 exitWith ec
82 exitWith ec
68
83
69 putStrLn "Sandbox built, beginning individual test suites"
84 putStrLn "Sandbox built, beginning individual test suites"
70− runTestSuites root ii
85+ runTestSuites settings ii
71
86
72 putStrLn "All test suites that were expected to pass did pass, building tarballs."
87 putStrLn "All test suites that were expected to pass did pass, building tarballs."
73 makeTarballs ii
88 makeTarballs ii
Stackage/CheckPlan.hs+3−3
@@ -16,9 +16,9 @@ import System.Process (readProcessWithExitCode)
16data Mismatch = OnlyDryRun String | OnlySimpleList String
16data Mismatch = OnlyDryRun String | OnlySimpleList String
17 deriving Show
17 deriving Show
18
18
19−checkPlan :: ([String] -> [String]) -> InstallInfo -> IO ()
19+checkPlan :: BuildSettings -> InstallInfo -> IO ()
20−checkPlan extraArgs ii = do
20+checkPlan settings ii = do
21− (ec, dryRun', stderr) <- readProcessWithExitCode "cabal" (extraArgs $ "install":"--dry-run":iiPackageList ii) ""
21+ (ec, dryRun', stderr) <- readProcessWithExitCode "cabal" (addCabalArgs settings $ "install":"--dry-run":iiPackageList ii) ""
22 when (ec /= ExitSuccess || "Warning:" `isPrefixOf` stderr) $ do
22 when (ec /= ExitSuccess || "Warning:" `isPrefixOf` stderr) $ do
23 putStr stderr
23 putStr stderr
24 putStr dryRun'
24 putStr dryRun'
Stackage/Config.hs+6−14
@@ -15,14 +15,14 @@ targetCompilerVersion =
15
15
16-- | Packages which are shipped with GHC but are not included in the
16-- | Packages which are shipped with GHC but are not included in the
17-- Haskell Platform list of core packages.
17-- Haskell Platform list of core packages.
18−extraCore :: Set PackageName
18+defaultExtraCore :: Set PackageName
19−extraCore = singleton $ PackageName "binary"
19+defaultExtraCore = singleton $ PackageName "binary"
20
20
21-- | Test suites which are expected to fail for some reason. The test suite
21-- | Test suites which are expected to fail for some reason. The test suite
22-- will still be run and logs kept, but a failure will not indicate an
22-- will still be run and logs kept, but a failure will not indicate an
23-- error in our package combination.
23-- error in our package combination.
24−expectedFailures :: Set PackageName
24+defaultExpectedFailures :: Set PackageName
25−expectedFailures = fromList $ map PackageName
25+defaultExpectedFailures = fromList $ map PackageName
26 [ -- Requires an old version of WAI and Warp for tests
26 [ -- Requires an old version of WAI and Warp for tests
27 "HTTP"
27 "HTTP"
28 -- Requires a special hspec-meta which is not yet available from
28 -- Requires a special hspec-meta which is not yet available from
@@ -58,8 +58,8 @@ expectedFailures = fromList $ map PackageName
58-- | List of packages for our stable Hackage. All dependencies will be
58-- | List of packages for our stable Hackage. All dependencies will be
59-- included as well. Please indicate who will be maintaining the package
59-- included as well. Please indicate who will be maintaining the package
60-- via comments.
60-- via comments.
61−stablePackages :: Map PackageName (VersionRange, Maintainer)
61+defaultStablePackages :: Map PackageName (VersionRange, Maintainer)
62−stablePackages = execWriter $ do
62+defaultStablePackages = execWriter $ do
63 mapM_ (add "michael@snoyman.com") $ words
63 mapM_ (add "michael@snoyman.com") $ words
64 "yesod yesod-newsfeed yesod-sitemap yesod-static yesod-test markdown filesystem-conduit mime-mail-ses"
64 "yesod yesod-newsfeed yesod-sitemap yesod-static yesod-test markdown filesystem-conduit mime-mail-ses"
65
65
@@ -80,11 +80,3 @@ stablePackages = execWriter $ do
80 case simpleParse range of
80 case simpleParse range of
81 Nothing -> error $ "Invalid range " ++ show range ++ " for " ++ package
81 Nothing -> error $ "Invalid range " ++ show range ++ " for " ++ package
82 Just range' -> tell $ Map.singleton (PackageName package) (range', Maintainer maintainer)
82 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
13import Stackage.Util
13import Stackage.Util
14import Data.Version (showVersion)
14import Data.Version (showVersion)
15
15
16−getInstallInfo :: IO InstallInfo
16+getInstallInfo :: BuildSettings -> IO InstallInfo
17−getInstallInfo = do
17+getInstallInfo settings = do
18 hp <- loadHaskellPlatform
18 hp <- loadHaskellPlatform
19− let allPackages = Map.union stablePackages $ identsToRanges (hplibs hp)
19+ let allPackages = Map.union (stablePackages settings) $ identsToRanges (hplibs hp)
20− let totalCore = extraCore `Set.union` Set.map (\(PackageIdentifier p _) -> p) (hpcore hp)
20+ let totalCore = extraCore settings `Set.union` Set.map (\(PackageIdentifier p _) -> p) (hpcore hp)
21 pdb <- loadPackageDB totalCore allPackages
21 pdb <- loadPackageDB totalCore allPackages
22 final <- narrowPackageDB pdb $ Set.fromList $ Map.toList $ Map.map snd $ allPackages
22 final <- narrowPackageDB pdb $ Set.fromList $ Map.toList $ Map.map snd $ allPackages
23
23
Stackage/Test.hs+8−8
@@ -20,12 +20,12 @@ import System.Process (runProcess, waitForProcess)
20import Control.Exception (handle, Exception, throwIO)
20import Control.Exception (handle, Exception, throwIO)
21import Data.Typeable (Typeable)
21import Data.Typeable (Typeable)
22
22
23−runTestSuites :: FilePath -> InstallInfo -> IO ()
23+runTestSuites :: BuildSettings -> InstallInfo -> IO ()
24−runTestSuites root ii = do
24+runTestSuites settings ii = do
25 let testdir = "runtests"
25 let testdir = "runtests"
26 rm_r testdir
26 rm_r testdir
27 createDirectory testdir
27 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
29 unless allPass $ error $ "There were failures, please see the logs in " ++ testdir
29 unless allPass $ error $ "There were failures, please see the logs in " ++ testdir
30 where
30 where
31 PackageDB pdb = iiPackageDB ii
31 PackageDB pdb = iiPackageDB ii
@@ -48,16 +48,16 @@ data TestException = TestException
48 deriving (Show, Typeable)
48 deriving (Show, Typeable)
49instance Exception TestException
49instance Exception TestException
50
50
51−runTestSuite :: FilePath
51+runTestSuite :: BuildSettings
52 -> FilePath
52 -> FilePath
53 -> (PackageName -> Bool) -- ^ do we have any test suites?
53 -> (PackageName -> Bool) -- ^ do we have any test suites?
54 -> Bool
54 -> Bool
55 -> (PackageName, (Version, Maintainer))
55 -> (PackageName, (Version, Maintainer))
56 -> IO Bool
56 -> IO Bool
57−runTestSuite root testdir hasTestSuites prevPassed (packageName, (version, Maintainer maintainer)) = do
57+runTestSuite settings testdir hasTestSuites prevPassed (packageName, (version, Maintainer maintainer)) = do
58 -- Set up a new environment that includes the sandboxed bin folder in PATH.
58 -- Set up a new environment that includes the sandboxed bin folder in PATH.
59 env' <- getEnvironment
59 env' <- getEnvironment
60− let menv = Just $ map (fixEnv $ binDir root) env'
60+ let menv = Just $ map (fixEnv $ binDir settings) env'
61
61
62 let run cmd args wdir handle = do
62 let run cmd args wdir handle = do
63 ph <- runProcess cmd args (Just wdir) menv Nothing (Just handle) (Just handle)
63 ph <- runProcess cmd args (Just wdir) menv Nothing (Just handle) (Just handle)
@@ -66,13 +66,13 @@ runTestSuite root testdir hasTestSuites prevPassed (packageName, (version, Maint
66
66
67 passed <- handle (\TestException -> return False) $ do
67 passed <- handle (\TestException -> return False) $ do
68 getHandle WriteMode $ run "cabal" ["unpack", package] testdir
68 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
70 when (hasTestSuites packageName) $ do
70 when (hasTestSuites packageName) $ do
71 getHandle AppendMode $ run "cabal" ["build"] dir
71 getHandle AppendMode $ run "cabal" ["build"] dir
72 getHandle AppendMode $ run "cabal" ["test"] dir
72 getHandle AppendMode $ run "cabal" ["test"] dir
73 getHandle AppendMode $ run "cabal" ["haddock"] dir
73 getHandle AppendMode $ run "cabal" ["haddock"] dir
74 return True
74 return True
75− let expectedFailure = packageName `Set.member` expectedFailures
75+ let expectedFailure = packageName `Set.member` expectedFailures settings
76 if passed
76 if passed
77 then do
77 then do
78 removeFile logfile
78 removeFile logfile
Stackage/Types.hs+9
@@ -53,3 +53,12 @@ data InstallInfo = InstallInfo
53-- | Email address of a Stackage maintainer.
53-- | Email address of a Stackage maintainer.
54newtype Maintainer = Maintainer { unMaintainer :: String }
54newtype Maintainer = Maintainer { unMaintainer :: String }
55 deriving (Show, Eq, Ord)
55 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
69defaultHasTestSuites :: Bool
69defaultHasTestSuites :: Bool
70defaultHasTestSuites = True
70defaultHasTestSuites = True
71
71
72−packageDir = (</> "package-db")
72+packageDir = (</> "package-db") . sandboxRoot
73−libDir = (</> "lib")
73+libDir = (</> "lib") . sandboxRoot
74−binDir = (</> "bin")
74+binDir = (</> "bin") . sandboxRoot
75
75
76−addCabalArgs root rest
76+addCabalArgs settings rest
77 = "--package-db=clear"
77 = "--package-db=clear"
78 : "--package-db=global"
78 : "--package-db=global"
79− : ("--package-db=" ++ packageDir root)
79+ : ("--package-db=" ++ packageDir settings)
80− : ("--libdir=" ++ libDir root)
80+ : ("--libdir=" ++ libDir settings)
81− : ("--bindir=" ++ binDir root)
81+ : ("--bindir=" ++ binDir settings)
82− : rest
82+ : extraArgs settings ++ rest
app/stackage.hs+2−2
@@ -1,4 +1,4 @@
1−import Stackage.Build (build)
1+import Stackage.Build (build, defaultBuildSettings)
2import Stackage.Init (stackageInit)
2import Stackage.Init (stackageInit)
3import System.Environment (getArgs, getProgName)
3import System.Environment (getArgs, getProgName)
4
4
@@ -6,7 +6,7 @@ main :: IO ()
6main = do
6main = do
7 args <- getArgs
7 args <- getArgs
8 case args of
8 case args of
9− ["build"] -> build "sandbox" id
9+ ["build"] -> build defaultBuildSettings
10 ["init"] -> stackageInit
10 ["init"] -> stackageInit
11 ["update"] -> stackageInit >> error "FIXME update"
11 ["update"] -> stackageInit >> error "FIXME update"
12 _ -> do
12 _ -> do