This commit is contained in:
Michael Snoyman 2012-12-03 07:08:53 +02:00
commit d5f456ef02
4 changed files with 32 additions and 17 deletions

View File

@ -5,7 +5,7 @@ module Stackage.Build
) where ) where
import Distribution.Text (simpleParse) import Distribution.Text (simpleParse)
import Control.Monad (unless) import Control.Monad (unless, when)
import Stackage.Types import Stackage.Types
import Stackage.CheckPlan import Stackage.CheckPlan
import Stackage.InstallInfo import Stackage.InstallInfo
@ -14,9 +14,9 @@ import Stackage.Test
import Stackage.Util import Stackage.Util
import Stackage.Config import Stackage.Config
import System.Exit (ExitCode (ExitSuccess), exitWith) import System.Exit (ExitCode (ExitSuccess), exitWith)
import System.IO (IOMode (WriteMode), withBinaryFile) import System.IO (IOMode (WriteMode), withBinaryFile, hPutStrLn)
import System.Process (runProcess, waitForProcess, rawSystem, readProcess) import System.Process (runProcess, waitForProcess, rawSystem, readProcess)
import System.Directory (createDirectoryIfMissing, canonicalizePath) import System.Directory (createDirectoryIfMissing, canonicalizePath, doesDirectoryExist)
import Distribution.Version (thisVersion, withinRange) import Distribution.Version (thisVersion, withinRange)
import Control.Exception (assert) import Control.Exception (assert)
@ -30,6 +30,7 @@ defaultBuildSettings = BuildSettings
, extraArgs = ["-fnetwork23"] , extraArgs = ["-fnetwork23"]
, haskellPlatformCabal = "haskell-platform/haskell-platform.cabal" , haskellPlatformCabal = "haskell-platform/haskell-platform.cabal"
, requireHaskellPlatform = True , requireHaskellPlatform = True
, cleanBeforeBuild = True
} }
build :: BuildSettings -> IO () build :: BuildSettings -> IO ()
@ -37,21 +38,28 @@ build settings' = do
putStrLn "Creating a build plan" putStrLn "Creating a build plan"
ii <- getInstallInfo settings' ii <- getInstallInfo settings'
putStrLn "Wiping out old sandbox folder"
let root' = sandboxRoot settings' let root' = sandboxRoot settings'
rm_r root' initPkgDb <- if cleanBeforeBuild settings'
rm_r "logs" then do
putStrLn "Wiping out old sandbox folder"
rm_r root'
rm_r "logs"
return True
else do
b <- doesDirectoryExist root'
when b (putStrLn "Re-using existing sandbox")
return (not b)
createDirectoryIfMissing True root' createDirectoryIfMissing True root'
root <- canonicalizePath root' root <- canonicalizePath root'
let settings = settings' { sandboxRoot = root } let settings = settings' { sandboxRoot = root }
ec1 <- rawSystem "ghc-pkg" ["init", packageDir settings] when initPkgDb $ do
unless (ec1 == ExitSuccess) $ do ec1 <- rawSystem "ghc-pkg" ["init", packageDir settings]
putStrLn "Unable to create package database via ghc-pkg init" unless (ec1 == ExitSuccess) $ do
exitWith ec1 putStrLn "Unable to create package database via ghc-pkg init"
exitWith ec1
checkPlan settings ii checkPlan settings ii
putStrLn "No mismatches, starting the sandboxed build." putStrLn "No mismatches, starting the sandboxed build."
versionString <- readProcess "cabal" ["--version"] "" versionString <- readProcess "cabal" ["--version"] ""
libVersion <- libVersion <-
@ -77,7 +85,8 @@ build settings' = do
, extraArgs settings , extraArgs settings
, iiPackageList ii , iiPackageList ii
] ]
in runProcess "cabal" args Nothing Nothing Nothing (Just handle) (Just handle) in do hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args))
runProcess "cabal" args Nothing Nothing Nothing (Just handle) (Just handle)
ec <- waitForProcess ph ec <- waitForProcess ph
unless (ec == ExitSuccess) $ do unless (ec == ExitSuccess) $ do
putStrLn "Build failed, please see build.log" putStrLn "Build failed, please see build.log"

View File

@ -68,6 +68,9 @@ defaultStablePackages = execWriter $ do
mapM_ (add "Antoine Latter") $ words mapM_ (add "Antoine Latter") $ words
"uuid byteorder" "uuid byteorder"
mapM (add "Stefan Wehr <wehr@factisresearch.com>") $ words
"HTF hscurses xmlgen stm-stats"
where where
add maintainer package = addRange maintainer package "-any" add maintainer package = addRange maintainer package "-any"
addRange maintainer package range = addRange maintainer package range =

View File

@ -63,4 +63,5 @@ data BuildSettings = BuildSettings
, extraArgs :: [String] , extraArgs :: [String]
, haskellPlatformCabal :: FilePath , haskellPlatformCabal :: FilePath
, requireHaskellPlatform :: Bool , requireHaskellPlatform :: Bool
, cleanBeforeBuild :: Bool
} }

View File

@ -1,3 +1,4 @@
import Stackage.Types (BuildSettings(..))
import Stackage.Build (build, defaultBuildSettings) import Stackage.Build (build, defaultBuildSettings)
import Stackage.Init (stackageInit) import Stackage.Init (stackageInit)
import System.Environment (getArgs, getProgName) import System.Environment (getArgs, getProgName)
@ -7,12 +8,13 @@ main = do
args <- getArgs args <- getArgs
case args of case args of
["build"] -> build defaultBuildSettings ["build"] -> build defaultBuildSettings
["build", "--no-clean"] -> build (defaultBuildSettings { cleanBeforeBuild = False })
["init"] -> stackageInit ["init"] -> stackageInit
["update"] -> stackageInit >> error "FIXME update" ["update"] -> stackageInit >> error "FIXME update"
_ -> do _ -> do
pn <- getProgName pn <- getProgName
putStrLn $ "Usage: " ++ pn ++ " <command>" putStrLn $ "Usage: " ++ pn ++ " <command>"
putStrLn "Available commands:" putStrLn "Available commands:"
putStrLn " update Download updated Stackage databases. Automatically calls init." putStrLn " update Download updated Stackage databases. Automatically calls init."
putStrLn " init Initialize your cabal file to use Stackage" putStrLn " init Initialize your cabal file to use Stackage"
putStrLn " build Build the package databases (maintainers only)" putStrLn " build [--no-clean] Build the package databases (maintainers only)"