git.iko.soy/stackage
on e005ca2 help sign in
stackage/Stackage/Build.hs
158 lines 6.3 kB history raw
1module Stackage.Build
2 ( build
3 , defaultBuildSettings
4 , BuildSettings (..)
5 ) where
7import Control.Exception (assert)
8import Control.Monad (unless, when)
9import qualified Data.Map as Map
10import Data.Set (empty)
11import qualified Data.Set as Set
12import Distribution.Text (simpleParse)
13import Distribution.Version (withinRange)
14import Stackage.CheckPlan
15import Stackage.Config
16import Stackage.InstallInfo
17import Stackage.Tarballs
18import Stackage.Test
19import Stackage.Types
20import Stackage.Util
21import System.Directory (canonicalizePath,
22 createDirectoryIfMissing,
23 doesDirectoryExist)
24import System.Exit (ExitCode (ExitSuccess), exitWith)
25import System.IO (IOMode (WriteMode), hPutStrLn,
26 withBinaryFile)
27import System.Process (rawSystem, readProcess, runProcess,
28 waitForProcess)
30defaultBuildSettings :: BuildSettings
31defaultBuildSettings = BuildSettings
32 { sandboxRoot = "sandbox"
33 , extraBuildArgs = []
34 , extraCore = defaultExtraCore
35 , expectedFailures = defaultExpectedFailures
36 , stablePackages = defaultStablePackages
37 , extraArgs = ["-fnetwork23"]
38 , haskellPlatformCabal = "haskell-platform/haskell-platform.cabal"
39 , requireHaskellPlatform = True
40 , cleanBeforeBuild = True
41 , excludedPackages = empty
42 , testWorkerThreads = 4
43 , flags = Set.fromList $ words "blaze_html_0_5"
44 , allowedPackage = const $ Right ()
45 }
47build :: BuildSettings -> IO ()
48build settings' = do
49 ii <- getInstallInfo settings'
51 let root' = sandboxRoot settings'
52 initPkgDb <- if cleanBeforeBuild settings'
53 then do
54 putStrLn "Wiping out old sandbox folder"
55 rm_r root'
56 rm_r "logs"
57 return True
58 else do
59 b <- doesDirectoryExist root'
60 when b (putStrLn "Re-using existing sandbox")
61 return (not b)
62 createDirectoryIfMissing True root'
63 root <- canonicalizePath root'
64 let settings = settings' { sandboxRoot = root }
66 when initPkgDb $ do
67 ec1 <- rawSystem "ghc-pkg" ["init", packageDir settings]
68 unless (ec1 == ExitSuccess) $ do
69 putStrLn "Unable to create package database via ghc-pkg init"
70 exitWith ec1
71 checkPlan settings ii
72 putStrLn "No mismatches, starting the sandboxed build."
74 versionString <- readProcess "cabal" ["--version"] ""
75 libVersion <-
76 case map words $ lines versionString of
77 [_,["using","version",libVersion,"of","the","Cabal","library"]] -> return libVersion
78 _ -> error "Did not understand cabal --version output"
80 case (simpleParse libVersion, simpleParse ">= 1.16") of
81 (Nothing, _) -> error $ "Invalid Cabal library version: " ++ libVersion
82 (_, Nothing) -> assert False $ return ()
83 (Just v, Just vr)
84 | v `withinRange` vr -> return ()
85 | otherwise -> error $ "Unsupported Cabal version: " ++ libVersion
87 menv <- fmap Just $ getModifiedEnv settings
88 let runCabal args handle = runProcess "cabal" args Nothing menv Nothing (Just handle) (Just handle)
90 -- First install build tools so they can be used below.
91 case iiBuildTools ii of
92 [] -> putStrLn "No build tools required"
93 tools -> do
94 putStrLn $ "Installing the following build tools: " ++ unwords tools
95 ph1 <- withBinaryFile "build-tools.log" WriteMode $ \handle -> do
96 let args = addCabalArgs settings
97 $ "install"
98 : ("--cabal-lib-version=" ++ libVersion)
99 : "--build-log=logs-tools/$pkg.log"
100 : "-j"
101 : concat
102 [ extraBuildArgs settings
103 , extraArgs settings
104 , iiBuildTools ii
105 ]
106 hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args))
107 runCabal args handle
108 ec1 <- waitForProcess ph1
109 unless (ec1 == ExitSuccess) $ do
110 putStrLn "Building of build tools failed, please see build-tools.log"
111 exitWith ec1
112 putStrLn "Build tools built"
114 ph <- withBinaryFile "build.log" WriteMode $ \handle -> do
115 let args = addCabalArgs settings
116 $ "install"
117 : ("--cabal-lib-version=" ++ libVersion)
118 : "--build-log=logs/$pkg.log"
119 : "-j"
120 : concat
121 [ extraBuildArgs settings
122 , extraArgs settings
123 , iiPackageList ii
124 ]
125 hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args))
126 runCabal args handle
127 ec <- waitForProcess ph
128 unless (ec == ExitSuccess) $ do
129 putStrLn "Build failed, please see build.log"
130 exitWith ec
132 putStrLn "Sandbox built, beginning individual test suites"
133 runTestSuites settings ii
135 putStrLn "All test suites that were expected to pass did pass, building tarballs."
136 makeTarballs ii
138-- | Get all of the build tools required.
139iiBuildTools :: InstallInfo -> [String]
140iiBuildTools InstallInfo { iiPackageDB = PackageDB m, iiPackages = packages } =
141 -- FIXME possible improvement: track the dependencies between the build
142 -- tools themselves, and install them in the correct order.
143 map unPackageName
144 $ filter (flip Set.notMember coreTools)
145 $ filter (flip Map.member m)
146 $ Set.toList
147 $ Set.unions
148 $ map piBuildTools
149 $ Map.elems
150 $ Map.filterWithKey isSelected m
151 where
152 unPackageName (PackageName pn) = pn
153 isSelected name _ = name `Set.member` selected
154 selected = Set.fromList $ Map.keys packages
156 -- Build tools shipped with GHC which we should not attempt to build
157 -- ourselves.
158 coreTools = Set.fromList $ map PackageName $ words "hsc2hs"