git.iko.soy/stackage
on a751d8a help sign in
stackage/Stackage/Build.hs
157 lines 6.2 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 (thisVersion, 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 }
45build :: BuildSettings -> IO ()
46build settings' = do
47 putStrLn "Creating a build plan"
48 ii <- getInstallInfo settings'
50 let root' = sandboxRoot settings'
51 initPkgDb <- if cleanBeforeBuild settings'
52 then do
53 putStrLn "Wiping out old sandbox folder"
54 rm_r root'
55 rm_r "logs"
56 return True
57 else do
58 b <- doesDirectoryExist root'
59 when b (putStrLn "Re-using existing sandbox")
60 return (not b)
61 createDirectoryIfMissing True root'
62 root <- canonicalizePath root'
63 let settings = settings' { sandboxRoot = root }
65 when initPkgDb $ do
66 ec1 <- rawSystem "ghc-pkg" ["init", packageDir settings]
67 unless (ec1 == ExitSuccess) $ do
68 putStrLn "Unable to create package database via ghc-pkg init"
69 exitWith ec1
70 checkPlan settings ii
71 putStrLn "No mismatches, starting the sandboxed build."
73 versionString <- readProcess "cabal" ["--version"] ""
74 libVersion <-
75 case map words $ lines versionString of
76 [_,["using","version",libVersion,"of","the","Cabal","library"]] -> return libVersion
77 _ -> error "Did not understand cabal --version output"
79 case (simpleParse libVersion, simpleParse ">= 1.16") of
80 (Nothing, _) -> error $ "Invalid Cabal library version: " ++ libVersion
81 (_, Nothing) -> assert False $ return ()
82 (Just v, Just vr)
83 | v `withinRange` vr -> return ()
84 | otherwise -> error $ "Unsupported Cabal version: " ++ libVersion
86 menv <- fmap Just $ getModifiedEnv settings
87 let runCabal args handle = runProcess "cabal" args Nothing menv Nothing (Just handle) (Just handle)
89 -- First install build tools so they can be used below.
90 case iiBuildTools ii of
91 [] -> putStrLn "No build tools required"
92 tools -> do
93 putStrLn $ "Installing the following build tools: " ++ unwords tools
94 ph1 <- withBinaryFile "build-tools.log" WriteMode $ \handle -> do
95 let args = addCabalArgs settings
96 $ "install"
97 : ("--cabal-lib-version=" ++ libVersion)
98 : "--build-log=logs-tools/$pkg.log"
99 : "-j"
100 : concat
101 [ extraBuildArgs settings
102 , extraArgs settings
103 , iiBuildTools ii
104 ]
105 hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args))
106 runCabal args handle
107 ec1 <- waitForProcess ph1
108 unless (ec1 == ExitSuccess) $ do
109 putStrLn "Building of build tools failed, please see build-tools.log"
110 exitWith ec1
111 putStrLn "Build tools built"
113 ph <- withBinaryFile "build.log" WriteMode $ \handle -> do
114 let args = addCabalArgs settings
115 $ "install"
116 : ("--cabal-lib-version=" ++ libVersion)
117 : "--build-log=logs/$pkg.log"
118 : "-j"
119 : concat
120 [ extraBuildArgs settings
121 , extraArgs settings
122 , iiPackageList ii
123 ]
124 hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args))
125 runCabal args handle
126 ec <- waitForProcess ph
127 unless (ec == ExitSuccess) $ do
128 putStrLn "Build failed, please see build.log"
129 exitWith ec
131 putStrLn "Sandbox built, beginning individual test suites"
132 runTestSuites settings ii
134 putStrLn "All test suites that were expected to pass did pass, building tarballs."
135 makeTarballs ii
137-- | Get all of the build tools required.
138iiBuildTools :: InstallInfo -> [String]
139iiBuildTools InstallInfo { iiPackageDB = PackageDB m, iiPackages = packages } =
140 -- FIXME possible improvement: track the dependencies between the build
141 -- tools themselves, and install them in the correct order.
142 map unPackageName
143 $ filter (flip Set.notMember coreTools)
144 $ filter (flip Map.member m)
145 $ Set.toList
146 $ Set.unions
147 $ map piBuildTools
148 $ Map.elems
149 $ Map.filterWithKey isSelected m
150 where
151 unPackageName (PackageName pn) = pn
152 isSelected name _ = name `Set.member` selected
153 selected = Set.fromList $ Map.keys packages
155 -- Build tools shipped with GHC which we should not attempt to build
156 -- ourselves.
157 coreTools = Set.fromList $ map PackageName $ words "hsc2hs"