git.iko.soy/stackage
on 0051979 help sign in
stackage/Stackage/Build.hs
129 lines 5.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.Maybe (mapMaybe)
11import Data.Set (empty)
12import qualified Data.Set as Set
13import Distribution.Text (simpleParse)
14import Distribution.Version (withinRange)
15import Prelude hiding (pi)
16import Stackage.CheckPlan
17import Stackage.Config
18import Stackage.InstallInfo
19import Stackage.Tarballs
20import Stackage.Test
21import Stackage.Types
22import Stackage.Util
23import System.Directory (canonicalizePath,
24 createDirectoryIfMissing,
25 doesDirectoryExist)
26import System.Exit (ExitCode (ExitSuccess), exitWith)
27import System.IO (IOMode (WriteMode), hPutStrLn,
28 withBinaryFile)
29import System.Process (rawSystem, readProcess, runProcess,
30 waitForProcess)
31import Stackage.Select (select)
32import Stackage.CheckCabalVersion (checkCabalVersion)
34defaultBuildSettings :: BuildSettings
35defaultBuildSettings = BuildSettings
36 { sandboxRoot = "sandbox"
37 , expectedFailuresBuild = defaultExpectedFailures
38 , extraArgs = ["-fnetwork23"]
39 , testWorkerThreads = 4
40 }
42build :: BuildSettings -> BuildPlan -> IO ()
43build settings' bp = do
44 putStrLn "Checking Cabal version"
45 libVersion <- checkCabalVersion
47 putStrLn "Wiping out old sandbox folder"
48 rm_r $ sandboxRoot settings'
49 rm_r "logs"
50 settings <- fixBuildSettings settings'
52 putStrLn "Creating new package database"
53 ec1 <- rawSystem "ghc-pkg" ["init", packageDir settings]
54 unless (ec1 == ExitSuccess) $ do
55 putStrLn "Unable to create package database via ghc-pkg init"
56 exitWith ec1
58 menv <- fmap Just $ getModifiedEnv settings
59 let runCabal args handle = runProcess "cabal" args Nothing menv Nothing (Just handle) (Just handle)
61 -- First install build tools so they can be used below.
62 case bpTools bp of
63 [] -> putStrLn "No build tools required"
64 tools -> do
65 putStrLn $ "Installing the following build tools: " ++ unwords tools
66 ph1 <- withBinaryFile "build-tools.log" WriteMode $ \handle -> do
67 let args = addCabalArgs settings
68 $ "install"
69 : ("--cabal-lib-version=" ++ libVersion)
70 : "--build-log=logs-tools/$pkg.log"
71 : "-j"
72 : concat
73 [ extraArgs settings
74 , tools
75 ]
76 hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args))
77 runCabal args handle
78 ec1 <- waitForProcess ph1
79 unless (ec1 == ExitSuccess) $ do
80 putStrLn "Building of build tools failed, please see build-tools.log"
81 exitWith ec1
82 putStrLn "Build tools built"
84 ph <- withBinaryFile "build.log" WriteMode $ \handle -> do
85 let args = addCabalArgs settings
86 $ "install"
87 : ("--cabal-lib-version=" ++ libVersion)
88 : "--build-log=logs/$pkg.log"
89 : "-j"
90 : concat
91 [ extraArgs settings
92 , bpPackageList bp
93 ]
94 hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args))
95 runCabal args handle
96 ec <- waitForProcess ph
97 unless (ec == ExitSuccess) $ do
98 putStrLn "Build failed, please see build.log"
99 exitWith ec
101-- | Get all of the build tools required.
102iiBuildTools :: InstallInfo -> [String]
103iiBuildTools InstallInfo { iiPackageDB = PackageDB m, iiPackages = packages } =
104 -- FIXME possible improvement: track the dependencies between the build
105 -- tools themselves, and install them in the correct order.
106 map unPackageName
107 $ filter (flip Set.notMember coreTools)
108 $ mapMaybe (flip Map.lookup buildToolMap)
109 $ Set.toList
110 $ Set.unions
111 $ map piBuildTools
112 $ Map.elems
113 $ Map.filterWithKey isSelected m
114 where
115 unPackageName (PackageName pn) = pn
116 isSelected name _ = name `Set.member` selected
117 selected = Set.fromList $ Map.keys packages
119 -- Build tools shipped with GHC which we should not attempt to build
120 -- ourselves.
121 coreTools = Set.fromList $ map PackageName $ words "hsc2hs"
123 -- The map from build tool name to the package it comes from.
124 buildToolMap = Map.unions $ map toBuildToolMap $ Map.toList m
125 toBuildToolMap :: (PackageName, PackageInfo) -> Map Executable PackageName
126 toBuildToolMap (pn, pi) = Map.unions
127 $ map (flip Map.singleton pn)
128 $ Set.toList
129 $ piExecs pi