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