buildbox 2.0.0.1 → 2.1.0.1

raw patch · 10 files changed

+101/−67 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• BuildBox.hs +3/−0
• BuildBox/Build.hs +3/−2
• BuildBox/Build/Base.hs +11/−0
• BuildBox/Build/BuildError.hs +17/−13
• BuildBox/Command/Environment.hs +8/−8
• BuildBox/Command/File.hs +11/−8
• BuildBox/Command/Mail.hs +5/−3
• BuildBox/Command/Network.hs +2/−2
• BuildBox/Command/System.hs +39/−30
• buildbox.cabal +2/−1

@@ -7,7 +7,9 @@         , runBuildWithState          -- * Errors+        , BuildError    (..)         , throw+        , catch         , needs          -- * Utils@@ -18,3 +20,4 @@         , outLn) where import BuildBox.Build+import Prelude          hiding (catch)

@@ -2,7 +2,6 @@ -- | Defines the main `Build` monad and common utils. module BuildBox.Build  	( module BuildBox.Build.Testable-	, module BuildBox.Build.BuildError 	, module BuildBox.Build.BuildState 	, Build @@ -14,7 +13,9 @@ 	, successfully  	-- * Errors+        , BuildError    (..) 	, throw+        , catch 	, needs  	-- * Utils@@ -36,7 +37,7 @@ import BuildBox.Build.BuildError import Control.Monad.State import System.IO-+import Prelude                  hiding (catch)  -- | Log a system command to the handle in our `BuildConfig`, if any. logSystem :: String -> Build ()

@@ -82,6 +82,17 @@ throw	= throwError  +-- | Run a build command, catching any exceptions it sends.+catch :: Build a -> (BuildError -> Build a) -> Build a+catch build handle+ = do   s            <- get+        (result, s') <- io $ runStateT (runErrorT build) s+        case result of+         Left err -> handle err+         Right x  +          -> do put s'+                return x+ -- | Throw a needs error saying we needs the given file. --   A catcher could then usefully create the file, or defer the compuation until it has been  --   created.

@@ -46,21 +46,25 @@  	ErrorSystemCmdFailed{} 	 -> vcat -		[ text "System command failure."+	 $ 	[ text "System command failure." 		, text "    command: " <> (text $ buildErrorCmd err) 		, text "  exit code: " <> (text $ show $ buildErrorCode err)-		, blank-		, if (not $ Log.null $ buildErrorStdout err)-		   then vcat 	[ text "-- stdout (last 10 lines) ------------------------------------------------------"-				, text $ Log.toString $ Log.lastLines 10 $ buildErrorStdout err]-		   else text ""-		, blank-		, if (not $ Log.null $ buildErrorStderr err)-		   then vcat	[ text "-- stderr (last 10 lines) ------------------------------------------------------"-				, text $ Log.toString $ Log.lastLines 10 $ buildErrorStderr err]-		   else text ""-		-		, 		  text "--------------------------------------------------------------------------------" ]+		, blank ] ++         ++ (if (not $ Log.null $ buildErrorStdout err)+	     then [ text "-- stdout (last 10 lines) ------------------------------------------------------"+		  , text $ Log.toString $ Log.lastLines 10 $ buildErrorStdout err]+	     else [])++         ++ (if (not $ Log.null $ buildErrorStderr err)+	     then [ text "-- stderr (last 10 lines) ------------------------------------------------------"+		  , text $ Log.toString $ Log.lastLines 10 $ buildErrorStderr err ]+	     else [])++	 ++ (if (  (not $ Log.null $ buildErrorStdout err)+               || (not $ Log.null $ buildErrorStderr err))+             then [ text "--------------------------------------------------------------------------------" ]+             else []) 	 	ErrorIOError ioerr 	 -> text "IO error: " <> (text $ show ioerr)

@@ -106,7 +106,7 @@ getHostName :: Build String getHostName  = do	check $ HasExecutable "uname"-	name	<- qssystemOut "uname -n"+	name   <- sesystemq "uname -n" 	return	$ init name  @@ -114,7 +114,7 @@ getHostArch :: Build String getHostArch  = do	check $ HasExecutable "arch"-	name	<- qssystemOut "arch"+	name   <- sesystemq "arch" 	return	$ init name  @@ -122,7 +122,7 @@ getHostProcessor :: Build String getHostProcessor  = do	check $ HasExecutable "uname"-	name	<- qssystemOut "uname -p"+	name   <- sesystemq "uname -p" 	return	$ init name  @@ -130,15 +130,15 @@ getHostOS :: Build String getHostOS  = do	check $ HasExecutable "uname"-	os	<- qssystemOut "uname -s"-	return	$ init os+	name   <- sesystemq "uname -s"+	return	$ init name   -- | Get the host operating system release, using @uname@. getHostRelease :: Build String getHostRelease  = do	check $ HasExecutable "uname"-	str	<- qssystemOut "uname -r"+	str    <- sesystemq "uname -r" 	return	$ init str  @@ -147,14 +147,14 @@ getVersionGHC :: FilePath -> Build String getVersionGHC path  = do	check $ HasExecutable path-	str	<- qssystemOut $ path ++ " --version"+	str	<- sesystemq $ path ++ " --version" 	return	$ init str 	 -- | Get the version of this GCC, or throw an error if it can't be found.  getVersionGCC :: FilePath -> Build String getVersionGCC path  = do	check $ HasExecutable path- 	str	<- qssystemOut $ path ++ " --version"+ 	str	<- sesystemq $ path ++ " --version" 	return	$ head $ lines str  

@@ -35,7 +35,7 @@  test prop   = case prop of 	HasExecutable name-	 -> do	code	<- qsystem $ "which " ++ name+	 -> do	(code, _, _) <- systemq $ "which " ++ name 		return	$ code == ExitSuccess  	HasFile path@@ -70,10 +70,10 @@ 	-- Make sure a dir with this name doesn't already exist. 	checkFalse $ HasDir name -	ssystem $ "mkdir -p " ++ name                                          -- TODO: rewrite without shell options+	ssystem $ "mkdir -p " ++ name               -- TODO: rewrite without shell options 	x	<- inDir name build -	ssystem $ "rm -Rf " ++ name                                            -- TODO: rewrite without shell opts+	ssystem $ "rm -Rf " ++ name                 -- TODO: rewrite without shell opts 	return x  @@ -82,8 +82,8 @@ --   not follow symlinks, it just deletes them. clobberDir :: FilePath -> Build () clobberDir path- = 	ssystem $ "rm -Rf " ++ path                                         -- TODO: rewrite without shell opts-+ = do   ssystemq $ "rm -Rf " ++ path                 -- TODO: rewrite without shell opts+        return ()  -- | Create a new directory if it isn't already there, or return successfully if it is. ensureDir :: FilePath -> Build ()@@ -91,7 +91,8 @@  = do	already	<- io $ doesDirectoryExist path 	if already 	 then return ()-	 else ssystem $ "mkdir -p " ++ path                                    -- TODO: rewrite without shell opts+	 else do ssystemq $ "mkdir -p " ++ path         -- TODO: rewrite without shell opts+                 return ()   -- | Create a temp file, pass it to some command, then delete the file after the command finishes.@@ -122,7 +123,8 @@         ensureDir buildDir  	-- Build the file name we'll try to use.-	let fileName	 = buildDir ++ "/buildbox-" ++ show buildId ++ "-" ++ show buildSeq       -- TODO: normalise path+	let fileName	 = buildDir ++ "/buildbox-" ++ show buildId ++ "-" ++ show buildSeq       +                                                -- TODO: normalise path  	-- If it already exists then something has gone badly wrong. 	--   Maybe the unique Id for the process wasn't as unique as we thought.@@ -143,4 +145,5 @@ atomicWriteFile filePath str  = do	tmp	<- newTempFile 	io $ writeFile tmp str-	ssystem $ "mv " ++ tmp ++ " " ++ filePath+	ssystemq $ "mv " ++ tmp ++ " " ++ filePath+        return ()

@@ -1,6 +1,8 @@ --- | Sending email. We've got baked in support for @msmtp@, which is easy to set up. Adding support for other mailers ---   should be easy. Get @msmtp@ here: <http://msmtp.sourceforge.net>+-- | Sending email. +--   If you're on a system with a working @sendmail@ then use that.+--   Otherwise, the stand-alone @msmtp@ server is easy to set up.+--   Get @msmtp@ here: <http://msmtp.sourceforge.net> module BuildBox.Command.Mail 	( Mail(..) 	, Mailer(..)@@ -54,7 +56,7 @@ -- | Create a mail with a given from, to, subject and body. --   Fill in the date and message id based on the current time. --   Valid dates and message ids are needed to prevent the mail---   being bounced by spambots.+--   being bounced by anti-spam systems. createMailWithCurrentTime  	:: String 	-- ^ ''from'' field. Should be an email address. 	-> String	-- ^ ''to'' field. Should be an email address.

@@ -29,7 +29,7 @@ 	-- -o               exit successfully after recieving one reply packet. 	HostReachable hostName 	 -> do	check	$ HasExecutable "ping"-		code	<- qsystem $ "ping -o " ++ hostName+		(code, _, _) <- systemq $ "ping -o " ++ hostName 		return $ code == ExitSuccess 		 	-- Works on OSX 10.6.2, wget 1.12@@ -37,7 +37,7 @@ 	--  --delete-after  delete page after downloading. 	UrlGettable url 	 -> do	check	$ HasExecutable "wget"-		code 	<- qsystem $ "wget -q --delete-after " ++ url+		(code, _, _) <- systemq $ "wget -q --delete-after " ++ url 		return	$ code == ExitSuccess 		 

@@ -12,11 +12,11 @@  	-- * Wrappers 	, system+	, systemq 	, ssystem-	, qsystem-	, qssystem-	, ssystemOut-	, qssystemOut+	, ssystemq+	, sesystem+	, sesystemq 	, systemTee 	, systemTeeLog 	, ssystemTee@@ -46,46 +46,55 @@   -- Wrappers ------------------------------------------------------------------------------------------ | Run a system command, returning its exit code.-system :: String -> Build ExitCode+-- | Run a system command, +--   returning its exit code and what it wrote to @stdout@ and @stderr@.+system :: String -> Build (ExitCode, String, String) system cmd- = do	(code, _, _)		<- systemTeeLog True cmd Log.empty-	return code+ = do	(code, logOut, logErr)    <- systemTeeLog True cmd Log.empty+	return (code, Log.toString logOut, Log.toString logErr)  --- | Run a successful system command.+-- | Quietly run a system command,+--   returning its exit code and what it wrote to @stdout@ and @stderr@.+systemq :: String -> Build (ExitCode, String, String)+systemq cmd+ = do	(code, logOut, logErr)    <- systemTeeLog False cmd Log.empty+        return (code, Log.toString logOut, Log.toString logErr)++++-- | Run a successful system command, +--   returning what it wrote to @stdout@ and @stderr@. --   If the exit code is `ExitFailure` then throw an error in the `Build` monad.-ssystem :: String -> Build ()+ssystem :: String -> Build (String, String) ssystem cmd- = do	(code, logOut, logErr)	<- systemTeeLog True cmd Log.empty--	when (code /= ExitSuccess)-	 $ throw $ ErrorSystemCmdFailed cmd code logOut logErr+ = do	(code, logOut, logErr)    <- systemTeeLog True cmd Log.empty +        when (code /= ExitSuccess)+         $ throw $ ErrorSystemCmdFailed cmd code logOut logErr --- | Quietly run a system command, returning its exit code.-qsystem :: String -> Build ExitCode-qsystem cmd- = do	(code, _, _)		<- systemTeeLog False cmd Log.empty-	return code+	return (Log.toString logOut, Log.toString logErr)  --- | Quietly run a successful system command.+-- | Quietly run a successful system command,+--   returning what it wrote to @stdout@ and @stderr@. --   If the exit code is `ExitFailure` then throw an error in the `Build` monad.-qssystem :: String -> Build ()-qssystem cmd- = do	(code, logOut, logErr)	<- systemTeeLog False cmd Log.empty+ssystemq :: String -> Build (String, String)+ssystemq cmd+ = do   (code, logOut, logErr)    <- systemTeeLog False cmd Log.empty -	when (code /= ExitSuccess)-	 $ throw $ ErrorSystemCmdFailed cmd code logOut logErr-	+        when (code /= ExitSuccess)+         $ throw $ ErrorSystemCmdFailed cmd code logOut logErr +        return (Log.toString logOut, Log.toString logErr)++ -- | Run a successful system command, returning what it wrote to its @stdout@. --   If anything was written to @stderr@ then treat that as failure.  --   If it fails due to writing to @stderr@ or returning `ExitFailure` --   then throw an error in the `Build` monad.-ssystemOut :: String -> Build String-ssystemOut cmd+sesystem :: String -> Build String+sesystem cmd  = do	(code, logOut, logErr)	<- systemTeeLog True cmd Log.empty 	when (code /= ExitSuccess || (not $ Log.null logErr)) 	 $ throw $ ErrorSystemCmdFailed cmd code logOut logErr@@ -96,8 +105,8 @@ --   If anything was written to @stderr@ then treat that as failure.  --   If it fails due to writing to @stderr@ or returning `ExitFailure` --   then throw an error in the `Build` monad.-qssystemOut :: String -> Build String-qssystemOut cmd+sesystemq :: String -> Build String+sesystemq cmd  = do	(code, logOut, logErr)	<- systemTeeLog False cmd Log.empty 	when (code /= ExitSuccess || (not $ Log.null logErr)) 	 $ throw $ ErrorSystemCmdFailed cmd code logOut logErr

@@ -1,5 +1,5 @@ Name:                buildbox-Version:             2.0.0.1+Version:             2.1.0.1 License:             BSD3 License-file:        LICENSE Author:              Ben Lippmeier@@ -35,6 +35,7 @@    ghc-options:         -Wall+        -fno-warn-unused-do-bind    Exposed-modules:         BuildBox.Build.Benchmark