buildbox 2.1.4.3 → 2.1.6.1

raw patch · 26 files changed

+1114/−1117 lines, 26 filesdep ~basedep ~randomdep ~timePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, random, time

API changes (from Hackage documentation)

Files

• BuildBox.hs +1/−1
• BuildBox/Build.hs +29/−29
• BuildBox/Build/Base.hs +51/−51
• BuildBox/Build/BuildError.hs +42/−42
• BuildBox/Build/BuildState.hs +21/−21
• BuildBox/Build/Testable.hs +23/−23
• BuildBox/Command/Darcs.hs +0/−1
• BuildBox/Command/Environment.hs +88/−88
• BuildBox/Command/File.hs +86/−86
• BuildBox/Command/Mail.hs +72/−73
• BuildBox/Command/Network.hs +26/−26
• BuildBox/Command/Sleep.hs +6/−6
• BuildBox/Command/System.hs +108/−108
• BuildBox/Command/System/Internals.hs +43/−43
• BuildBox/Control/Cron.hs +22/−22
• BuildBox/Control/Gang.hs +127/−127
• BuildBox/Data/Comparison.hs +30/−30
• BuildBox/Data/Detail.hs +38/−38
• BuildBox/Data/Dividable.hs +5/−5
• BuildBox/Data/Log.hs +35/−35
• BuildBox/Data/Range.hs +16/−16
• BuildBox/Data/Schedule.hs +124/−124
• BuildBox/IO/Directory.hs +38/−38
• BuildBox/Pretty.hs +31/−31
• BuildBox/Time.hs +43/−44
• buildbox.cabal +9/−9

@@ -1,6 +1,6 @@  module BuildBox-	( Build+        ( Build          -- * Building         , runBuild

@@ -1,34 +1,34 @@  -- | Defines the main `Build` monad and common utils. module BuildBox.Build -	( module BuildBox.Build.Testable-	, module BuildBox.Build.BuildState-	, Build+        ( module BuildBox.Build.Testable+        , module BuildBox.Build.BuildState+        , Build -	-- * Building-	, runBuild-	, runBuildWithState-	, runBuildPrint-	, runBuildPrintWithState-	, successfully+        -- * Building+        , runBuild+        , runBuildWithState+        , runBuildPrint+        , runBuildPrintWithState+        , successfully -	-- * Errors+        -- * Errors         , BuildError    (..)-	, throw+        , throw         , catch-	, needs+        , needs -	-- * Utils-	, io-	, whenM+        -- * Utils+        , io+        , whenM -	-- * Output-	, out-	, outLn-	, outBlank-	, outLine-	, outLINE-	, logSystem)+        -- * Output+        , out+        , outLn+        , outBlank+        , outLine+        , outLINE+        , logSystem)  where import BuildBox.Build.Base@@ -43,12 +43,12 @@ -- | Log a system command to the handle in our `BuildConfig`, if any. logSystem :: String -> Build () logSystem cmd- = do	mHandle	<- gets buildStateLogSystem-	case mHandle of-	 Nothing	-> return ()-	 Just handle	-	  -> do	io $ hPutStr   handle "buildbox system: "-		io $ hPutStrLn handle cmd-		return ()+ = do   mHandle <- gets buildStateLogSystem+        case mHandle of+         Nothing        -> return ()+         Just handle    +          -> do io $ hPutStr   handle "buildbox system: "+                io $ hPutStrLn handle cmd+                return ()  

@@ -13,7 +13,7 @@  -- | The builder monad encapsulates and IO action that can fail with an error,  --   and also read some global configuration info.-type Build a 	= ErrorT BuildError (StateT BuildState IO) a+type Build a    = ErrorT BuildError (StateT BuildState IO) a   -- Build ------------------------------------------------------------------------------------------@@ -21,65 +21,65 @@ --   temporary files (like \"/tmp\") runBuild :: FilePath -> Build a -> IO (Either BuildError a) runBuild scratchDir build- = do	uid	<- getUniqueId-	let s	= buildStateDefault uid scratchDir-	evalStateT (runErrorT build) s+ = do   uid     <- getUniqueId+        let s   = buildStateDefault uid scratchDir+        evalStateT (runErrorT build) s   -- | Like 'runBuild`, but report whether it succeeded to the console. --   If it succeeded then return Just the result, else Nothing. runBuildPrint :: FilePath -> Build a -> IO (Maybe a) runBuildPrint scratchDir build- = do	uid	<- getUniqueId-	let s	= buildStateDefault uid scratchDir-	runBuildPrintWithState s build+ = do   uid     <- getUniqueId+        let s   = buildStateDefault uid scratchDir+        runBuildPrintWithState s build   -- | Like `runBuild` but also takes a `BuildState`. runBuildWithState :: BuildState -> Build a -> IO (Maybe a) runBuildWithState s build- = do	result	<- evalStateT (runErrorT build) s-	case result of-	 Left err-	  -> do	putStrLn $ render $ ppr err-		return $ Nothing-		-	 Right x-	  -> do	return $ Just x+ = do   result  <- evalStateT (runErrorT build) s+        case result of+         Left err+          -> do putStrLn $ render $ ppr err+                return $ Nothing+                +         Right x+          -> do return $ Just x   -- | Like `runBuildPrint` but also takes a `BuildState`. runBuildPrintWithState :: BuildState -> Build a -> IO (Maybe a) runBuildPrintWithState s build- = do	result	<- evalStateT (runErrorT build) s-	case result of-	 Left err-	  -> do	putStrLn "\nBuild failed"-		putStr   "  due to "-		putStrLn $ render $ ppr err-		return $ Nothing-		-	 Right x-	  -> do	putStrLn "Build succeeded."-		return $ Just x+ = do   result  <- evalStateT (runErrorT build) s+        case result of+         Left err+          -> do putStrLn "\nBuild failed"+                putStr   "  due to "+                putStrLn $ render $ ppr err+                return $ Nothing+                +         Right x+          -> do putStrLn "Build succeeded."+                return $ Just x   -- | Discard the resulting value of a compuation. --   Used like @successfully . runBuild ...@ successfully :: IO a -> IO ()-successfully f 	= f >> return ()+successfully f  = f >> return ()   -- | Get a unique(ish) id for this process. --   The random seeds the global generator with the cpu time in psecs, which should be good enough. getUniqueId :: IO Integer getUniqueId- 	= randomRIO (0, 1000000000)	+        = randomRIO (0, 1000000000)       -- Errors ----------------------------------------------------------------------------------------- -- | Throw an error in the build monad. throw :: BuildError -> Build a-throw	= throwError+throw   = throwError   -- | Run a build command, catching any exceptions it sends.@@ -98,12 +98,12 @@ --   created. needs :: FilePath -> Build () needs filePath- = do	isFile	<- io $ doesFileExist filePath-	isDir	<- io $ doesDirectoryExist filePath-	-	if isFile || isDir-	 then return ()-	 else throw $ ErrorNeeds filePath+ = do   isFile  <- io $ doesFileExist filePath+        isDir   <- io $ doesDirectoryExist filePath+        +        if isFile || isDir+         then return ()+         else throw $ ErrorNeeds filePath   -- Utils ------------------------------------------------------------------------------------------@@ -112,45 +112,45 @@ --   `ErrorIOError` exceptions in our `Build` monad. io :: IO a -> Build a io x- = do	-- catch IOError exceptions-	result	<- liftIO $ try x-	-	case result of-	 Left err	-> throw $ ErrorIOError err-	 Right res	-> return res+ = do   -- catch IOError exceptions+        result  <- liftIO $ try x+        +        case result of+         Left err       -> throw $ ErrorIOError err+         Right res      -> return res   -- | Like `when`, but with teh monadz. whenM :: Monad m => m Bool -> m () -> m () whenM cb cx- = do	b	<- cb-	if b then cx else return ()+ = do   b       <- cb+        if b then cx else return ()   -- Output ----------------------------------------------------------------------------------------- -- | Print some text to stdout. out :: Pretty a => a -> Build ()-out str	+out str   = io - $ do	putStr   $ render $ ppr str-	hFlush stdout+ $ do   putStr   $ render $ ppr str+        hFlush stdout  -- | Print some text to stdout followed by a newline. outLn :: Pretty a => a -> Build ()-outLn str	= io $ putStrLn $ render $ ppr str+outLn str       = io $ putStrLn $ render $ ppr str   -- | Print a blank line to stdout outBlank :: Build ()-outBlank	= out $ text "\n"+outBlank        = out $ text "\n"   -- | Print a @-----@ line to stdout  outLine :: Build ()-outLine 	= io $ putStr (replicate 80 '-' ++ "\n")+outLine         = io $ putStr (replicate 80 '-' ++ "\n")   -- | Print a @=====@ line to stdout outLINE :: Build ()-outLINE		= io $ putStr (replicate 80 '=' ++ "\n")-	+outLINE         = io $ putStr (replicate 80 '=' ++ "\n")+        

@@ -2,38 +2,38 @@ {-# OPTIONS_HADDOCK hide #-}  module BuildBox.Build.BuildError-	(BuildError(..))+        (BuildError(..)) where import BuildBox.Pretty import System.Exit import Control.Monad.Error-import BuildBox.Data.Log		(Log)-import qualified BuildBox.Data.Log	as Log+import BuildBox.Data.Log                (Log)+import qualified BuildBox.Data.Log      as Log   -- BuildError ------------------------------------------------------------------------------------- -- | The errors we recognise. data BuildError-	-- | Some generic error-	= ErrorOther String+        -- | Some generic error+        = ErrorOther String -	-- | Some system command fell over, and it barfed out the given stdout and stderr.-	| ErrorSystemCmdFailed-		{ buildErrorCmd 	:: String-		, buildErrorCode	:: ExitCode-		, buildErrorStdout	:: Log-		, buildErrorStderr	:: Log }-		-	-- | Some miscellanous IO action failed.-	| ErrorIOError IOError+        -- | Some system command fell over, and it barfed out the given stdout and stderr.+        | ErrorSystemCmdFailed+                { buildErrorCmd         :: String+                , buildErrorCode        :: ExitCode+                , buildErrorStdout      :: Log+                , buildErrorStderr      :: Log }+                +        -- | Some miscellanous IO action failed.+        | ErrorIOError IOError -	-- | Some property `check` was supposed to return the given boolean value, but it didn't.-	| forall prop. Show prop => ErrorCheckFailed Bool prop	+        -- | Some property `check` was supposed to return the given boolean value, but it didn't.+        | forall prop. Show prop => ErrorCheckFailed Bool prop   -	-- | A build command needs the following file to continue.-	--   This can be used for writing make-like bots.-	| ErrorNeeds FilePath-	+        -- | A build command needs the following file to continue.+        --   This can be used for writing make-like bots.+        | ErrorNeeds FilePath+          instance Error BuildError where  strMsg s = ErrorOther s@@ -41,39 +41,39 @@ instance Pretty BuildError where  ppr err   = case err of-	ErrorOther str-	 -> text "Other error: " <> text str+        ErrorOther str+         -> text "Other error: " <> text str -	ErrorSystemCmdFailed{}-	 -> vcat -	 $ 	[ text "System command failure."-		, text "    command: " <> (text $ buildErrorCmd err)-		, text "  exit code: " <> (text $ show $ buildErrorCode err)-		, blank ] +        ErrorSystemCmdFailed{}+         -> vcat +         $      [ text "System command failure."+                , text "    command: " <> (text $ buildErrorCmd err)+                , text "  exit code: " <> (text $ show $ buildErrorCode err)+                , blank ]            ++ (if (not $ Log.null $ buildErrorStdout err)-	     then [ text "-- stdout (last 10 lines) ------------------------------------------------------"-		  , text $ Log.toString $ Log.lastLines 10 $ buildErrorStdout err]-	     else [])+             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 [])+             then [ text "-- stderr (last 10 lines) ------------------------------------------------------"+                  , text $ Log.toString $ Log.lastLines 10 $ buildErrorStderr err ]+             else []) -	 ++ (if (  (not $ Log.null $ buildErrorStdout err)+         ++ (if (  (not $ Log.null $ buildErrorStdout err)                || (not $ Log.null $ buildErrorStderr err))              then [ text "--------------------------------------------------------------------------------" ]              else [])-	-	ErrorIOError ioerr-	 -> text "IO error: " <> (text $ show ioerr)+        +        ErrorIOError ioerr+         -> text "IO error: " <> (text $ show ioerr) -	ErrorCheckFailed expected prop-	 -> text "Check failure: " <> (text $ show prop) <> (text " expected ") <> (text $ show expected)+        ErrorCheckFailed expected prop+         -> text "Check failure: " <> (text $ show prop) <> (text " expected ") <> (text $ show expected) -	ErrorNeeds filePath-	 -> text "Build needs: " <> text filePath+        ErrorNeeds filePath+         -> text "Build needs: " <> text filePath   instance Show BuildError where

@@ -1,36 +1,36 @@ {-# OPTIONS_HADDOCK hide #-}  module BuildBox.Build.BuildState-	( BuildState(..)-	, buildStateDefault)+        ( BuildState(..)+        , buildStateDefault) where import System.IO  -- BuildConfig ------------------------------------------------------------------------------------ -- | Global builder configuration. data BuildState-	= BuildState-	{ -- | Log all system commands executed to this file handle.-	  buildStateLogSystem	:: Maybe Handle-	-	  -- | Uniqueish id for this build process.-	  --   On POSIX we'd use the PID, but that doesn't work on Windows.-	  --   The id is initialised by the Haskell random number generator on startup.-	, buildStateId		:: Integer-	-	  -- | Sequence number for generating fresh file names.-	, buildStateSeq		:: Integer -	-	  -- | Scratch directory for making temp files.-	, buildStateScratchDir	:: FilePath }+        = BuildState+        { -- | Log all system commands executed to this file handle.+          buildStateLogSystem   :: Maybe Handle+        +          -- | Uniqueish id for this build process.+          --   On POSIX we'd use the PID, but that doesn't work on Windows.+          --   The id is initialised by the Haskell random number generator on startup.+        , buildStateId          :: Integer+        +          -- | Sequence number for generating fresh file names.+        , buildStateSeq         :: Integer +        +          -- | Scratch directory for making temp files.+        , buildStateScratchDir  :: FilePath }   -- | The default build config. buildStateDefault :: Integer -> FilePath -> BuildState buildStateDefault uniqId scratchDir -	= BuildState-	{ buildStateLogSystem	= Nothing-	, buildStateId		= uniqId-	, buildStateSeq		= 0 -	, buildStateScratchDir	= scratchDir }+        = BuildState+        { buildStateLogSystem   = Nothing+        , buildStateId          = uniqId+        , buildStateSeq         = 0 +        , buildStateScratchDir  = scratchDir } 

@@ -3,13 +3,13 @@ -- --   They have `Show` instances so we can make nice error messages if a `check` fails. module BuildBox.Build.Testable-	( Testable(..)-	, check-	, checkFalse-	, outCheckOk-	, outCheckFalseOk)+        ( Testable(..)+        , check+        , checkFalse+        , outCheckOk+        , outCheckFalseOk) where-import BuildBox.Build.Base	+import BuildBox.Build.Base       import BuildBox.Build.BuildError import Control.Monad.Error @@ -22,38 +22,38 @@ --   If the check returns false then throw an error. check :: (Show prop, Testable prop) => prop -> Build () check prop- = do	result	<- test prop-	if result-	 then return ()-	 else throwError $ ErrorCheckFailed True prop+ = do   result  <- test prop+        if result+         then return ()+         else throwError $ ErrorCheckFailed True prop   -- | Testable properties are checkable. --   If the check returns true then throw an error. checkFalse :: (Show prop, Testable prop) => prop -> Build () checkFalse prop- = do	result	<- test prop-	if result-	 then throwError $ ErrorCheckFailed False prop-	 else return ()-	+ = do   result  <- test prop+        if result+         then throwError $ ErrorCheckFailed False prop+         else return ()+          -- | Check some property while printing what we're doing. outCheckOk -	:: (Show prop, Testable prop) -	=> String -> prop -> Build ()+        :: (Show prop, Testable prop) +        => String -> prop -> Build ()  outCheckOk str prop- = do	outLn str-	check prop+ = do   outLn str+        check prop   -- | Check some property while printing what we're doing. outCheckFalseOk -	:: (Show prop, Testable prop) -	=> String -> prop -> Build ()+        :: (Show prop, Testable prop) +        => String -> prop -> Build ()  outCheckFalseOk str prop- = do	outLn str-	checkFalse prop+ = do   outLn str+        checkFalse prop 

@@ -11,7 +11,6 @@ -- standard libraries import Data.Time import Data.Maybe-import System.Locale import qualified Data.Sequence          as Seq import qualified Data.ByteString.Char8  as B 

@@ -1,22 +1,22 @@  -- | Gathering information about the build environment. module BuildBox.Command.Environment-	( -- * Build Environment-	  Environment(..)-	, getEnvironmentWith-	-	  -- * Build platform-	, Platform(..)-	, getHostPlatform-	, getHostName-	, getHostArch-	, getHostProcessor-	, getHostOS-	, getHostRelease-	-	  -- * Software versions-	, getVersionGHC-	, getVersionGCC)+        ( -- * Build Environment+          Environment(..)+        , getEnvironmentWith+        +          -- * Build platform+        , Platform(..)+        , getHostPlatform+        , getHostName+        , getHostArch+        , getHostProcessor+        , getHostOS+        , getHostRelease+        +          -- * Software versions+        , getVersionGHC+        , getVersionGCC) where import BuildBox.Build import BuildBox.Command.System@@ -27,134 +27,134 @@ -- Environment ------------------------------------------------------------------------------------ -- | The environment consists of the `Platform`, and some tool versions. data Environment -	= Environment-	{ environmentPlatform	:: Platform-	, environmentVersions	:: [(String, String)] }-	deriving (Show, Read)+        = Environment+        { environmentPlatform   :: Platform+        , environmentVersions   :: [(String, String)] }+        deriving (Show, Read)   instance Pretty Environment where  ppr env-	= hang (ppr "Environment") 2 $ vcat-	[ ppr 	$ environmentPlatform env-	, hang (ppr "Versions") 2 -		$ vcat -		$ map (\(name, ver) -> ppr name <+> ppr ver) -		$ environmentVersions env ]+        = hang (ppr "Environment") 2 $ vcat+        [ ppr   $ environmentPlatform env+        , hang (ppr "Versions") 2 +                $ vcat +                $ map (\(name, ver) -> ppr name <+> ppr ver) +                $ environmentVersions env ]    -- | Get the current environment, including versions of these tools. getEnvironmentWith -	:: [(String, Build String)]	-- ^ List of tool names and commands to get their versions.-	-> Build Environment-	+        :: [(String, Build String)]     -- ^ List of tool names and commands to get their versions.+        -> Build Environment+         getEnvironmentWith nameGets - = do	platform	<- getHostPlatform+ = do   platform        <- getHostPlatform -	versions	<- mapM (\(name, get) -> do-					ver	<- get-					return	(name, ver))-			$  nameGets-			-	return	$ Environment-		{ environmentPlatform	= platform -		, environmentVersions	= versions }-	+        versions        <- mapM (\(name, get) -> do+                                        ver     <- get+                                        return  (name, ver))+                        $  nameGets+                        +        return  $ Environment+                { environmentPlatform   = platform +                , environmentVersions   = versions }+           -- Platform --------------------------------------------------------------------------------------- -- | Generic information about the platform we're running on. data Platform-	= Platform-	{ platformHostName 	:: String-	, platformHostArch	:: String-	, platformHostProcessor	:: String-	, platformHostOS	:: String-	, platformHostRelease	:: String }-	deriving (Show, Read)-	-	+        = Platform+        { platformHostName      :: String+        , platformHostArch      :: String+        , platformHostProcessor :: String+        , platformHostOS        :: String+        , platformHostRelease   :: String }+        deriving (Show, Read)+        +         instance Pretty Platform where  ppr plat-	= hang (ppr "Platform") 2 $ vcat-	[ ppr "host:      " <> (ppr $ platformHostName plat)-	, ppr "arch:      " <> (ppr $ platformHostArch plat)-	, ppr "processor: " <> (ppr $ platformHostProcessor plat)-	, ppr "system:    " <> (ppr $ platformHostOS plat) <+> (ppr $ platformHostRelease plat) ]+        = hang (ppr "Platform") 2 $ vcat+        [ ppr "host:      " <> (ppr $ platformHostName plat)+        , ppr "arch:      " <> (ppr $ platformHostArch plat)+        , ppr "processor: " <> (ppr $ platformHostProcessor plat)+        , ppr "system:    " <> (ppr $ platformHostOS plat) <+> (ppr $ platformHostRelease plat) ]   -- | Get information about the host platform. getHostPlatform :: Build Platform getHostPlatform - = do	name		<- getHostName-	arch		<- getHostArch-	processor	<- getHostProcessor-	os		<- getHostOS-	release		<- getHostRelease-	-	return	$ Platform-		{ platformHostName	= name-		, platformHostArch	= arch-		, platformHostProcessor	= processor-		, platformHostOS	= os-		, platformHostRelease	= release }-		+ = do   name            <- getHostName+        arch            <- getHostArch+        processor       <- getHostProcessor+        os              <- getHostOS+        release         <- getHostRelease+        +        return  $ Platform+                { platformHostName      = name+                , platformHostArch      = arch+                , platformHostProcessor = processor+                , platformHostOS        = os+                , platformHostRelease   = release }+                  -- Platform Tests --------------------------------------------------------------------------------- -- | Get the name of this host, using @uname@. getHostName :: Build String getHostName- = do	check $ HasExecutable "uname"-	name   <- sesystemq "uname -n"-	return	$ init name+ = do   check $ HasExecutable "uname"+        name   <- sesystemq "uname -n"+        return  $ init name   -- | Get the host architecture, using @uname@. getHostArch :: Build String getHostArch- = do	check $ HasExecutable "arch"-	name   <- sesystemq "arch"-	return	$ init name+ = do   check $ HasExecutable "arch"+        name   <- sesystemq "arch"+        return  $ init name   -- | Get the host processor name, using @uname@. getHostProcessor :: Build String getHostProcessor- = do	check $ HasExecutable "uname"-	name   <- sesystemq "uname -p"-	return	$ init name+ = do   check $ HasExecutable "uname"+        name   <- sesystemq "uname -p"+        return  $ init name   -- | Get the host operating system, using @uname@. getHostOS :: Build String getHostOS- = do	check $ HasExecutable "uname"-	name   <- sesystemq "uname -s"-	return	$ init name+ = do   check $ HasExecutable "uname"+        name   <- sesystemq "uname -s"+        return  $ init name   -- | Get the host operating system release, using @uname@. getHostRelease :: Build String getHostRelease- = do	check $ HasExecutable "uname"-	str    <- sesystemq "uname -r"-	return	$ init str+ = do   check $ HasExecutable "uname"+        str    <- sesystemq "uname -r"+        return  $ init str   -- Software version tests ------------------------------------------------------------------------- -- | Get the version of this GHC, or throw an error if it can't be found. getVersionGHC :: FilePath -> Build String getVersionGHC path- = do	check $ HasExecutable path-	str	<- sesystemq $ path ++ " --version"-	return	$ init str-	+ = do   check $ HasExecutable path+        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	<- sesystemq $ path ++ " --version"-	return	$ head $ lines str+ = do   check $ HasExecutable path+        str     <- sesystemq $ path ++ " --version"+        return  $ head $ lines str  

@@ -1,13 +1,13 @@  -- | Working with the file system. module BuildBox.Command.File-	( PropFile(..)-	, inDir-	, inScratchDir-	, clobberDir-	, ensureDir-	, withTempFile-	, atomicWriteFile+        ( PropFile(..)+        , inDir+        , inScratchDir+        , clobberDir+        , ensureDir+        , withTempFile+        , atomicWriteFile         , exe ) where import BuildBox.Build@@ -19,51 +19,51 @@ -- | Properties of the file system we can test for. data PropFile -	-- | Some executable is in the current path.-	= HasExecutable	String+        -- | Some executable is in the current path.+        = HasExecutable String -	-- | Some file exists.-	| HasFile	FilePath+        -- | Some file exists.+        | HasFile       FilePath -	-- | Some directory exists.-	| HasDir  	FilePath+        -- | Some directory exists.+        | HasDir        FilePath -	-- | Some file is empty.-	| FileEmpty 	FilePath-	deriving Show+        -- | Some file is empty.+        | FileEmpty     FilePath+        deriving Show   instance Testable PropFile where  test prop   = case prop of-	HasExecutable name-	 -> do	bin <- io $ findExecutable name-		return $ case bin of-		 Just _	 	-> True-		 Nothing 	-> False+        HasExecutable name+         -> do  bin <- io $ findExecutable name+                return $ case bin of+                 Just _         -> True+                 Nothing        -> False -	HasFile path-	 -> io $ doesFileExist path+        HasFile path+         -> io $ doesFileExist path -	HasDir  path-	 -> io $ doesDirectoryExist path+        HasDir  path+         -> io $ doesDirectoryExist path -	FileEmpty  path-	 -> do	contents	<- io $ readFile path-		return (null contents)+        FileEmpty  path+         -> do  contents        <- io $ readFile path+                return (null contents)   -- | Run a command in a different working directory. Throws an error if the directory doesn't exist. inDir :: FilePath -> Build a -> Build a inDir name build- = do	check $ HasDir name-	oldDir	<- io $ getCurrentDirectory+ = do   check $ HasDir name+        oldDir  <- io $ getCurrentDirectory -	io $ setCurrentDirectory name-	x	<- build-	io $ setCurrentDirectory oldDir+        io $ setCurrentDirectory name+        x       <- build+        io $ setCurrentDirectory oldDir -	return x+        return x  -- | Create a new directory with the given name, run a command within it, --   then change out and recursively delete the directory. Throws an error if a directory@@ -71,100 +71,100 @@ inScratchDir :: FilePath -> Build a -> Build a inScratchDir name build  = do-	-- Make sure a dir with this name doesn't already exist.-	checkFalse $ HasDir name+        -- Make sure a dir with this name doesn't already exist.+        checkFalse $ HasDir name -	ensureDir name-	x	<- inDir name build-	clobberDir name+        ensureDir name+        x       <- inDir name build+        clobberDir name -	return x+        return x   -- | Delete a dir recursively if it's there, otherwise do nothing. clobberDir :: FilePath -> Build () clobberDir path- = do	e <- io $ try $ removeDirectoryRecursive path- 	case (e :: Either SomeException ()) of- 	 _	-> return ()+ = do   e <- io $ try $ removeDirectoryRecursive path+        case (e :: Either SomeException ()) of+         _      -> return ()   -- | Create a new directory if it isn't already there, or return successfully if it is. ensureDir :: FilePath -> Build () ensureDir path- = do	already	<- io $ doesDirectoryExist path-	if already-	 then return ()-	 else do e <- io $ try $ createDirectoryIfMissing True path-	 	 case (e :: Either SomeException ()) of-		  _	-> return ()+ = do   already <- io $ doesDirectoryExist path+        if already+         then return ()+         else do e <- io $ try $ createDirectoryIfMissing True path+                 case (e :: Either SomeException ()) of+                  _     -> return ()   -- | Create a temp file, pass it to some command, then delete the file after the command finishes. withTempFile :: (FilePath -> Build a) -> Build a withTempFile build- = do	fileName	<- newTempFile+ = do   fileName        <- newTempFile -	-- run the real command-	result	<- build fileName+        -- run the real command+        result  <- build fileName -	-- cleanup-	io $ removeFile fileName+        -- cleanup+        io $ removeFile fileName -	return result+        return result   -- | Allocate a new temporary file name newTempFile :: Build FilePath newTempFile- = do	buildDir	<- gets buildStateScratchDir-	buildId		<- gets buildStateId-	buildSeq	<- gets buildStateSeq+ = do   buildDir        <- gets buildStateScratchDir+        buildId         <- gets buildStateId+        buildSeq        <- gets buildStateSeq -	-- Increment the sequence number.-	modify $ \s -> s { buildStateSeq = buildStateSeq s + 1 }+        -- Increment the sequence number.+        modify $ \s -> s { buildStateSeq = buildStateSeq s + 1 }          -- Ensure the build directory exists, or canonicalizePath will fail         ensureDir buildDir -	-- Build the file name we'll try to use.-	-- We need to account for a blank scratch directory, otherwise there is-	-- no way to use the CD as a scratch on Windows.-	let fileName	 = (if (null buildDir) then "" else (buildDir ++ "/"))-		++ "buildbox-" ++ show buildId ++ "-" ++ show buildSeq+        -- Build the file name we'll try to use.+        -- We need to account for a blank scratch directory, otherwise there is+        -- no way to use the CD as a scratch on Windows.+        let fileName     = (if (null buildDir) then "" else (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.-	exists		<- io $ doesFileExist fileName-	when exists-	 $ error "buildbox: panic, supposedly fresh file already exists."+        -- If it already exists then something has gone badly wrong.+        --   Maybe the unique Id for the process wasn't as unique as we thought.+        exists          <- io $ doesFileExist fileName+        when exists+         $ error "buildbox: panic, supposedly fresh file already exists." -	-- Touch the file for good measure.-	--   If the unique id wasn't then we want to detect this.-	io $ writeFile fileName ""+        -- Touch the file for good measure.+        --   If the unique id wasn't then we want to detect this.+        io $ writeFile fileName "" -	io $ canonicalizePath fileName+        io $ canonicalizePath fileName   -- | Atomically write a file by first writing it to a tmp file then renaming it. --   This prevents concurrent processes from reading half-written files. atomicWriteFile :: FilePath -> String -> Build () atomicWriteFile filePath str- = do	tmp	<- newTempFile-	io $ writeFile tmp str-	e <- io $ try $ renameFile tmp filePath+ = do   tmp     <- newTempFile+        io $ writeFile tmp str+        e <- io $ try $ renameFile tmp filePath -	-- renameFile may not be able to rename files across physical devices, -	-- depending on the implementation. If renameFile fails then try copyFile.-	case (e :: Either SomeException ()) of-	 Right _ 	   - 	  -> return ()+        -- renameFile may not be able to rename files across physical devices, +        -- depending on the implementation. If renameFile fails then try copyFile.+        case (e :: Either SomeException ()) of+         Right _           +          -> return () -	 Left _- 	  -> do	io $ copyFile tmp filePath-		io $ removeFile tmp-		return ()+         Left _+          -> do io $ copyFile tmp filePath+                io $ removeFile tmp+                return ()   -- | The file extension for an executable on the current system.

@@ -4,17 +4,16 @@ --   Otherwise, the stand-alone @msmtp@ server is easy to set up. --   Get @msmtp@ here: <http://msmtp.sourceforge.net> module BuildBox.Command.Mail-	( Mail(..)-	, Mailer(..)-	, createMailWithCurrentTime-	, renderMail-	, sendMailWithMailer)+        ( Mail(..)+        , Mailer(..)+        , createMailWithCurrentTime+        , renderMail+        , sendMailWithMailer) where import BuildBox.Build import BuildBox.Pretty import BuildBox.Command.Environment import BuildBox.Command.System-import System.Locale	(defaultTimeLocale) import Data.Time.Clock import Data.Time.LocalTime import Data.Time.Format@@ -23,34 +22,34 @@  -- | An email message that we can send. data Mail-	= Mail-	{ mailFrom		:: String-	, mailTo		:: String-	, mailSubject		:: String-	, mailTime		:: UTCTime-	, mailTimeZone		:: TimeZone-	, mailMessageId		:: String-	, mailBody		:: String }-	deriving Show+        = Mail+        { mailFrom              :: String+        , mailTo                :: String+        , mailSubject           :: String+        , mailTime              :: UTCTime+        , mailTimeZone          :: TimeZone+        , mailMessageId         :: String+        , mailBody              :: String }+        deriving Show   -- | An external mailer that can send messages.---   	Also contains mail server info if needed.+--      Also contains mail server info if needed. data Mailer-	-- | Send the mail by writing to the stdin of this command.-	--   On many systems the command 'sendmail' will be aliased to an appropriate-	--   wrapper for whatever Mail Transfer Agent (MTA) you have installed.-	= MailerSendmail-	{ mailerPath		:: FilePath-	, mailerExtraFlags	:: [String] }+        -- | Send the mail by writing to the stdin of this command.+        --   On many systems the command 'sendmail' will be aliased to an appropriate+        --   wrapper for whatever Mail Transfer Agent (MTA) you have installed.+        = MailerSendmail+        { mailerPath            :: FilePath+        , mailerExtraFlags      :: [String] } -	-- | Send mail via MSMTP, which is a stand-alone SMTP sender.-	--   This might be be easier to set up if you don't have a real MTA installed.-	--   Get it from http://msmtp.sourceforge.net/-	| MailerMSMTP-	{ mailerPath		:: FilePath-	, mailerPort		:: Maybe Int }-	deriving Show+        -- | Send mail via MSMTP, which is a stand-alone SMTP sender.+        --   This might be be easier to set up if you don't have a real MTA installed.+        --   Get it from http://msmtp.sourceforge.net/+        | MailerMSMTP+        { mailerPath            :: FilePath+        , mailerPort            :: Maybe Int }+        deriving Show   -- | Create a mail with a given from, to, subject and body.@@ -58,68 +57,68 @@ --   Valid dates and message ids are needed to prevent the mail --   being bounced by anti-spam systems. createMailWithCurrentTime -	:: String 	-- ^ ''from'' field. Should be an email address.-	-> String	-- ^ ''to'' field. Should be an email address.-	-> String	-- ^ Subject line.-	-> String	-- ^ Message  body.-	-> Build Mail+        :: String       -- ^ ''from'' field. Should be an email address.+        -> String       -- ^ ''to'' field. Should be an email address.+        -> String       -- ^ Subject line.+        -> String       -- ^ Message  body.+        -> Build Mail  createMailWithCurrentTime from to subject body  = do-	-- We need to add the date otherwise our messages will get marked as spam.-	-- Use RFC 2822 format timestamp.-	utime		<- io $ getCurrentTime-	zone		<- io $ getCurrentTimeZone+        -- We need to add the date otherwise our messages will get marked as spam.+        -- Use RFC 2822 format timestamp.+        utime           <- io $ getCurrentTime+        zone            <- io $ getCurrentTimeZone -	-- Generate a messageid based on the clock time.-	hostName	<- getHostName-	let dayNum	= toModifiedJulianDay $ utctDay utime-	let secTime	= utctDayTime utime-	let messageId	=  "<" ++ show dayNum ++ "." ++ (init $ show secTime)-			++ "@" ++ hostName ++ ">"-		-	return	$ Mail-		{ mailFrom	= from-		, mailTo	= to-		, mailSubject	= subject-		, mailTime	= utime-		, mailTimeZone	= zone-		, mailMessageId	= messageId-		, mailBody	= body }+        -- Generate a messageid based on the clock time.+        hostName        <- getHostName+        let dayNum      = toModifiedJulianDay $ utctDay utime+        let secTime     = utctDayTime utime+        let messageId   =  "<" ++ show dayNum ++ "." ++ (init $ show secTime)+                        ++ "@" ++ hostName ++ ">"+                +        return  $ Mail+                { mailFrom      = from+                , mailTo        = to+                , mailSubject   = subject+                , mailTime      = utime+                , mailTimeZone  = zone+                , mailMessageId = messageId+                , mailBody      = body }   -- | Render an email message as a string. renderMail :: Mail -> Doc renderMail mail  = vcat-	[ ppr "From: "		<> ppr (mailFrom mail)-	, ppr "To: "		<> ppr (mailTo   mail)-	, ppr "Subject: "	<> ppr (mailSubject mail)-	, ppr "Date: "		<> (ppr $ formatTime defaultTimeLocale "%a, %e %b %Y %H:%M:%S %z"-					$ utcToZonedTime (mailTimeZone mail) (mailTime mail))+        [ ppr "From: "          <> ppr (mailFrom mail)+        , ppr "To: "            <> ppr (mailTo   mail)+        , ppr "Subject: "       <> ppr (mailSubject mail)+        , ppr "Date: "          <> (ppr $ formatTime defaultTimeLocale "%a, %e %b %Y %H:%M:%S %z"+                                        $ utcToZonedTime (mailTimeZone mail) (mailTime mail)) -	, ppr "Message-Id: " 	<> ppr (mailMessageId mail)-	, ppr ""-	, ppr (mailBody mail) ]+        , ppr "Message-Id: "    <> ppr (mailMessageId mail)+        , ppr ""+        , ppr (mailBody mail) ]   -- | Send a mail message. sendMailWithMailer :: Mail -> Mailer -> Build () sendMailWithMailer mail mailer  = case mailer of-	MailerSendmail{}	-	 -> ssystemTee False-		(mailerPath mailer-			++ " -t ") -- read recipients from the mail-		(render $ renderMail mail)+        MailerSendmail{}        +         -> ssystemTee False+                (mailerPath mailer+                        ++ " -t ") -- read recipients from the mail+                (render $ renderMail mail) -	MailerMSMTP{}	-	 -> ssystemTee False-		(mailerPath mailer -			++ " -t " -- read recipients from the mail-			++ (maybe "" (\port -> " --port=" ++ show port) $ mailerPort mailer))-		(render $ renderMail mail)-		+        MailerMSMTP{}   +         -> ssystemTee False+                (mailerPath mailer +                        ++ " -t " -- read recipients from the mail+                        ++ (maybe "" (\port -> " --port=" ++ show port) $ mailerPort mailer))+                (render $ renderMail mail)+                   

@@ -1,46 +1,46 @@  -- | Working with the network. module BuildBox.Command.Network-	(PropNetwork(..))+        (PropNetwork(..)) where import BuildBox.Build import BuildBox.Command.File import BuildBox.Command.System -type HostName	= String-type URL	= String+type HostName   = String+type URL        = String  data PropNetwork -	-- | The given host is reachable with @ping@.-	= HostReachable	HostName+        -- | The given host is reachable with @ping@.+        = HostReachable HostName -	-- | Use @wget@ to check if a web-page is gettable.-	--   The page is deleted after downloading.-	| UrlGettable	URL+        -- | Use @wget@ to check if a web-page is gettable.+        --   The page is deleted after downloading.+        | UrlGettable   URL -	deriving Show-	+        deriving Show+         instance Testable PropNetwork where  test prop   = case prop of -	-- Works on OSX 10.6.2-	-- -o               exit successfully after recieving one reply packet.-	HostReachable hostName-	 -> do	check	$ HasExecutable "ping"-		(code, _, _) <- systemq $ "ping -o " ++ hostName-		return $ code == ExitSuccess-		-	-- Works on OSX 10.6.2, wget 1.12-	--  -q              quiet-	--  --delete-after  delete page after downloading.-	UrlGettable url-	 -> do	check	$ HasExecutable "wget"-		(code, _, _) <- systemq $ "wget -q --delete-after " ++ url-		return	$ code == ExitSuccess-		+        -- Works on OSX 10.6.2+        -- -o               exit successfully after recieving one reply packet.+        HostReachable hostName+         -> do  check   $ HasExecutable "ping"+                (code, _, _) <- systemq $ "ping -o " ++ hostName+                return $ code == ExitSuccess+                +        -- Works on OSX 10.6.2, wget 1.12+        --  -q              quiet+        --  --delete-after  delete page after downloading.+        UrlGettable url+         -> do  check   $ HasExecutable "wget"+                (code, _, _) <- systemq $ "wget -q --delete-after " ++ url+                return  $ code == ExitSuccess+                  -	+         

@@ -1,8 +1,8 @@  -- | What do build 'bots dream about? module BuildBox.Command.Sleep-	( sleep-	, msleep)+        ( sleep+        , msleep) where import BuildBox.Build import Control.Concurrent@@ -10,11 +10,11 @@  -- | Sleep for a given number of seconds. sleep :: Int -> Build ()-sleep secs	-	= io $ threadDelay $ secs * 1000000+sleep secs      +        = io $ threadDelay $ secs * 1000000 -	+         -- | Sleep for a given number of milliseconds. msleep :: Int -> Build () msleep msecs-	= io $ threadDelay $ msecs * 1000+        = io $ threadDelay $ msecs * 1000

@@ -8,22 +8,22 @@ --   buildbots, and we usually need all the versions...  module BuildBox.Command.System -	( module System.Exit+        ( module System.Exit -	-- * Wrappers-	, system-	, systemq-	, ssystem-	, ssystemq-	, sesystem-	, sesystemq-	, systemTee-	, systemTeeLog-	, ssystemTee-	, systemTeeIO+        -- * Wrappers+        , system+        , systemq+        , ssystem+        , ssystemq+        , sesystem+        , sesystemq+        , systemTee+        , systemTeeLog+        , ssystemTee+        , systemTeeIO -	-- * The real function-	, systemTeeLogIO)+        -- * The real function+        , systemTeeLogIO) where import BuildBox.Command.System.Internals import BuildBox.Build@@ -33,16 +33,16 @@ import Control.Monad.STM import System.Exit import System.IO-import Data.ByteString.Char8		(ByteString)-import BuildBox.Data.Log		(Log)-import System.Process			hiding (system)-import qualified BuildBox.Data.Log	as Log+import Data.ByteString.Char8            (ByteString)+import BuildBox.Data.Log                (Log)+import System.Process                   hiding (system)+import qualified BuildBox.Data.Log      as Log  debug :: Bool-debug	= False+debug   = False  trace :: String -> IO ()-trace s	= when debug $ putStrLn s+trace s = when debug $ putStrLn s   -- Wrappers ---------------------------------------------------------------------------------------@@ -50,15 +50,15 @@ --   returning its exit code and what it wrote to @stdout@ and @stderr@. system :: String -> Build (ExitCode, String, String) system cmd- = do	(code, logOut, logErr)    <- systemTeeLog True cmd Log.empty-	return (code, Log.toString logOut, Log.toString logErr)+ = do   (code, logOut, logErr)    <- systemTeeLog True cmd Log.empty+        return (code, Log.toString logOut, Log.toString logErr)   -- | 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+ = do   (code, logOut, logErr)    <- systemTeeLog False cmd Log.empty         return (code, Log.toString logOut, Log.toString logErr)  @@ -68,12 +68,12 @@ --   If the exit code is `ExitFailure` then throw an error in the `Build` monad. ssystem :: String -> Build (String, String) ssystem cmd- = do	(code, logOut, logErr)    <- systemTeeLog True cmd Log.empty+ = do   (code, logOut, logErr)    <- systemTeeLog True cmd Log.empty          when (code /= ExitSuccess)          $ throw $ ErrorSystemCmdFailed cmd code logOut logErr -	return (Log.toString logOut, Log.toString logErr)+        return (Log.toString logOut, Log.toString logErr)   -- | Quietly run a successful system command,@@ -95,11 +95,11 @@ --   then throw an error in the `Build` monad. 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+ = do   (code, logOut, logErr)  <- systemTeeLog True cmd Log.empty+        when (code /= ExitSuccess || (not $ Log.null logErr))+         $ throw $ ErrorSystemCmdFailed cmd code logOut logErr -	return $ Log.toString logOut+        return $ Log.toString logOut  -- | Quietly run a successful system command, returning what it wrote to its @stdout@. --   If anything was written to @stderr@ then treat that as failure. @@ -107,11 +107,11 @@ --   then throw an error in the `Build` monad. 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+ = do   (code, logOut, logErr)  <- systemTeeLog False cmd Log.empty+        when (code /= ExitSuccess || (not $ Log.null logErr))+         $ throw $ ErrorSystemCmdFailed cmd code logOut logErr -	return $ Log.toString logOut+        return $ Log.toString logOut   @@ -120,114 +120,114 @@ -- | Like `systemTeeIO`, but in the `Build` monad. systemTee :: Bool -> String -> String -> Build (ExitCode, String, String) systemTee tee cmd strIn- = do	logSystem cmd-	io $ systemTeeIO tee cmd strIn+ = do   logSystem cmd+        io $ systemTeeIO tee cmd strIn  -- | Like `systemTeeLogIO`, but in the `Build` monad. systemTeeLog :: Bool -> String -> Log -> Build (ExitCode, Log, Log) systemTeeLog tee cmd logIn- = do	logSystem cmd-	io $ systemTeeLogIO tee cmd logIn+ = do   logSystem cmd+        io $ systemTeeLogIO tee cmd logIn   -- | Like `systemTeeIO`, but in the `Build` monad and throw an error if it returns `ExitFailure`. ssystemTee  :: Bool -> String -> String -> Build () ssystemTee tee cmd strIn- = do	(code, logOut, logErr)	<- systemTeeLog tee cmd (Log.fromString strIn)-	when (code /= ExitSuccess)-	 $ throw $ ErrorSystemCmdFailed cmd code logOut logErr+ = do   (code, logOut, logErr)  <- systemTeeLog tee cmd (Log.fromString strIn)+        when (code /= ExitSuccess)+         $ throw $ ErrorSystemCmdFailed cmd code logOut logErr   -- | Like `systemTeeLogIO`, but with strings. systemTeeIO :: Bool -> String -> String -> IO (ExitCode, String, String) systemTeeIO tee cmd strIn- = do	(code, logOut, logErr)	<- systemTeeLogIO tee cmd $ Log.fromString strIn-	return	(code, Log.toString logOut, Log.toString logErr)+ = do   (code, logOut, logErr)  <- systemTeeLogIO tee cmd $ Log.fromString strIn+        return  (code, Log.toString logOut, Log.toString logErr)   -- | Run a system command, returning its `ExitCode` and what was written to @stdout@ and @stderr@. systemTeeLogIO-	:: Bool 	-- ^ Whether @stdout@ and @stderr@ should be forwarded to the parent process.-	-> String 	-- ^ Command to run.-	-> Log		-- ^ What to pass to the command's @stdin@.-	-> IO (ExitCode, Log, Log)+        :: Bool         -- ^ Whether @stdout@ and @stderr@ should be forwarded to the parent process.+        -> String       -- ^ Command to run.+        -> Log          -- ^ What to pass to the command's @stdin@.+        -> IO (ExitCode, Log, Log)  systemTeeLogIO tee cmd logIn- = do	trace $ "systemTeeIO " ++ show tee ++ ": " ++ cmd+ = do   trace $ "systemTeeIO " ++ show tee ++ ": " ++ cmd -	-- Create some new pipes for the process to write its stdout and stderr to.-	trace $ "systemTeeIO: Creating process"-	(Just hInWrite, Just hOutRead, Just hErrRead, phProc)-	 	<- createProcess -		$  CreateProcess-			{ cmdspec	= ShellCommand cmd-			, cwd		= Nothing-			, env		= Nothing-			, std_in	= CreatePipe-			, std_out	= CreatePipe-			, std_err	= CreatePipe-			, close_fds	= False +        -- Create some new pipes for the process to write its stdout and stderr to.+        trace $ "systemTeeIO: Creating process"+        (Just hInWrite, Just hOutRead, Just hErrRead, phProc)+                <- createProcess +                $  CreateProcess+                        { cmdspec       = ShellCommand cmd+                        , cwd           = Nothing+                        , env           = Nothing+                        , std_in        = CreatePipe+                        , std_out       = CreatePipe+                        , std_err       = CreatePipe+                        , close_fds     = False                          , create_group  = False                         , delegate_ctlc = False } -	-- Push input into in handle. Close the handle afterwards to ensure the-	-- process gets sent the EOF character.-	hPutStr hInWrite $ Log.toString logIn-	hClose  hInWrite-			-	-- To implement the tee-like behavior we'll fork some threads that read lines from the-	-- processes stdout and stderr and write them to these channels. -	-- 	When they hit EOF they signal this via the semaphores.-	chanOut		<- newTChanIO-	chanErr		<- newTChanIO-	semOut		<- newQSem 0-	semErr		<- newQSem 0+        -- Push input into in handle. Close the handle afterwards to ensure the+        -- process gets sent the EOF character.+        hPutStr hInWrite $ Log.toString logIn+        hClose  hInWrite+                        +        -- To implement the tee-like behavior we'll fork some threads that read lines from the+        -- processes stdout and stderr and write them to these channels. +        --      When they hit EOF they signal this via the semaphores.+        chanOut         <- newTChanIO+        chanErr         <- newTChanIO+        semOut          <- newQSem 0+        semErr          <- newQSem 0 -	-- Make duplicates of the above, which will store everything-	-- written to them. This gives us the copy to return from the fn.-	chanOutAcc	<- atomically $ dupTChan chanOut-	chanErrAcc	<- atomically $ dupTChan chanErr+        -- Make duplicates of the above, which will store everything+        -- written to them. This gives us the copy to return from the fn.+        chanOutAcc      <- atomically $ dupTChan chanOut+        chanErrAcc      <- atomically $ dupTChan chanErr -	-- Fork threads to read from the process handles and write to our channels.-	_tidOut		<- forkIO $ streamIn hOutRead chanOut-	_tidErr		<- forkIO $ streamIn hErrRead chanErr+        -- Fork threads to read from the process handles and write to our channels.+        _tidOut         <- forkIO $ streamIn hOutRead chanOut+        _tidErr         <- forkIO $ streamIn hErrRead chanErr -	-- If tee-like behavior is turned on, we forward what the process writes to-	--	its stdout and stderr to the parent.-	_tidStream	<- forkIO $ streamOuts-				[ (chanOut, if tee then Just stdout else Nothing, semOut)-				, (chanErr, if tee then Just stderr else Nothing, semErr) ]+        -- If tee-like behavior is turned on, we forward what the process writes to+        --      its stdout and stderr to the parent.+        _tidStream      <- forkIO $ streamOuts+                                [ (chanOut, if tee then Just stdout else Nothing, semOut)+                                , (chanErr, if tee then Just stderr else Nothing, semErr) ] -	-- Wait for the main process to complete.-	code		<- waitForProcess phProc-	trace $ "systemTeeIO: Process done, code = " ++ show code+        -- Wait for the main process to complete.+        code            <- waitForProcess phProc+        trace $ "systemTeeIO: Process done, code = " ++ show code -	trace $ "systemTeeIO: Waiting for sems"-	-- Wait for the tee processes to finish.-	--	We need to do this to avoid corrupted output on the console due to our forwarding-	--	threads writing at the same time as successing Build commands.-	mapM_ waitQSem [semOut, semErr]+        trace $ "systemTeeIO: Waiting for sems"+        -- Wait for the tee processes to finish.+        --      We need to do this to avoid corrupted output on the console due to our forwarding+        --      threads writing at the same time as successing Build commands.+        mapM_ waitQSem [semOut, semErr] -	trace $ "systemTeeIO: Getting output"-	-- Get what was written to its stdout and stderr.-	--	getChanContents is a lazy read, so don't pull from the channel after-	--	seeing a Nothing else we'll block forever.-	logOut		<- slurpChan chanOutAcc Log.empty-	logErr		<- slurpChan chanErrAcc Log.empty+        trace $ "systemTeeIO: Getting output"+        -- Get what was written to its stdout and stderr.+        --      getChanContents is a lazy read, so don't pull from the channel after+        --      seeing a Nothing else we'll block forever.+        logOut          <- slurpChan chanOutAcc Log.empty+        logErr          <- slurpChan chanErrAcc Log.empty -	trace $ "systemTeeIO stdout: " ++ Log.toString logOut-	trace $ "systemTeeIO stderr: " ++ Log.toString logErr+        trace $ "systemTeeIO stdout: " ++ Log.toString logOut+        trace $ "systemTeeIO stderr: " ++ Log.toString logErr -	trace $ "systemTeeIO: All done"-	hClose hOutRead-	hClose hErrRead-	code `seq` logOut `seq` logErr `seq` -		return	(code, logOut, logErr)+        trace $ "systemTeeIO: All done"+        hClose hOutRead+        hClose hErrRead+        code `seq` logOut `seq` logErr `seq` +                return  (code, logOut, logErr)  slurpChan :: TChan (Maybe ByteString) -> Log -> IO Log slurpChan !chan !ll- = do	mStr	<- atomically $ readTChan chan-	case mStr of-	 Nothing	-> return ll-	 Just str	-> slurpChan chan (ll Log.|> str)+ = do   mStr    <- atomically $ readTChan chan+        case mStr of+         Nothing        -> return ll+         Just str       -> slurpChan chan (ll Log.|> str) 

@@ -1,7 +1,7 @@ {-# LANGUAGE PatternGuards, BangPatterns, NamedFieldPuns #-} module BuildBox.Command.System.Internals-	( streamIn-	, streamOuts)+        ( streamIn+        , streamOuts) where import System.IO import Control.Concurrent@@ -12,9 +12,9 @@ import Data.IORef import Data.Char import Data.Word-import Data.ByteString.Char8		(ByteString)+import Data.ByteString.Char8            (ByteString) import qualified Data.ByteString.Internal       as BS-import qualified Data.ByteString.Char8	        as BS	+import qualified Data.ByteString.Char8          as BS     import GHC.IO.Handle.Internals import GHC.IO.Handle.Types@@ -86,53 +86,53 @@ streamOuts !chans   = streamOuts' False [] chans -	-- There doesn't seem to be a way to perform a unix-style "select" on channels.-	-- We want to wait until any of the channels becomes available for reading.-	-- We're doing this just by polling them each in turn, and waiting a bit-	--	if none of them had any data.-		- where	-- we're done.-	streamOuts' _ []   []	-		= return ()+        -- There doesn't seem to be a way to perform a unix-style "select" on channels.+        -- We want to wait until any of the channels becomes available for reading.+        -- We're doing this just by polling them each in turn, and waiting a bit+        --      if none of them had any data.+                + where  -- we're done.+        streamOuts' _ []   []   +                = return () -	-- play it again, sam.-	streamOuts' True prev []	-	 = 	streamOuts' False [] prev+        -- play it again, sam.+        streamOuts' True prev []        +         =      streamOuts' False [] prev -	streamOuts' False prev []-	 = do   threadDelay 1000+        streamOuts' False prev []+         = do   threadDelay 1000                 yield-		streamOuts' False [] prev+                streamOuts' False [] prev  -	-- try to read from the current chan.-	streamOuts' !active !prev (!x@(!chan, !mHandle, !qsem) : rest)-	 = do	-		-- try and read a string from the channel, but don't block-		-- if there aren't any.-		mStr	<- atomically-			$  do	isEmpty	<- isEmptyTChan chan-				if isEmpty -				 then    return (False, Nothing)+        -- try to read from the current chan.+        streamOuts' !active !prev (!x@(!chan, !mHandle, !qsem) : rest)+         = do   +                -- try and read a string from the channel, but don't block+                -- if there aren't any.+                mStr    <- atomically+                        $  do   isEmpty <- isEmptyTChan chan+                                if isEmpty +                                 then    return (False, Nothing) -				 else do mStr	<- readTChan chan-					 return (True, mStr)-				-		case mStr of-		 (False, _)-		  -> streamOuts' active (prev ++ [x]) rest+                                 else do mStr   <- readTChan chan+                                         return (True, mStr)+                                +                case mStr of+                 (False, _)+                  -> streamOuts' active (prev ++ [x]) rest -		 (True, Nothing)-		  -> do	signalQSem qsem-			streamOuts' active prev rest+                 (True, Nothing)+                  -> do signalQSem qsem+                        streamOuts' active prev rest -		 (True, Just str)-		  | Just h	<- mHandle-		  -> do	BS.hPutStr h str-			hPutChar   h '\n'-			streamOuts' True (prev ++ [x]) rest+                 (True, Just str)+                  | Just h      <- mHandle+                  -> do BS.hPutStr h str+                        hPutChar   h '\n'+                        streamOuts' True (prev ++ [x]) rest -		  | otherwise-		  -> 	streamOuts' True (prev ++ [x]) rest					+                  | otherwise+                  ->    streamOuts' True (prev ++ [x]) rest                                        -- Code hacked out of Data.ByteString library.

@@ -3,8 +3,8 @@  -- | A simple ''cron'' loop. Used for running commands according to a given schedule. module BuildBox.Control.Cron-	( module BuildBox.Data.Schedule-	, cronLoop )+        ( module BuildBox.Data.Schedule+        , cronLoop ) where import BuildBox.Build import BuildBox.Data.Schedule@@ -18,26 +18,26 @@ -- cronLoop :: Schedule (Build ())-> Build () cronLoop schedule- = do	startTime	<- io $ getCurrentTime+ = do   startTime       <- io $ getCurrentTime -	case earliestEventToStartAt startTime $ eventsOfSchedule schedule of-	 Nothing -	  -> do	sleep 1-		cronLoop schedule-		-	 Just event -	  -> do	let Just build	= lookupCommandOfSchedule (eventName event) schedule-		build-		endTime		<- io $ getCurrentTime+        case earliestEventToStartAt startTime $ eventsOfSchedule schedule of+         Nothing +          -> do sleep 1+                cronLoop schedule+                +         Just event +          -> do let Just build  = lookupCommandOfSchedule (eventName event) schedule+                build+                endTime         <- io $ getCurrentTime -		let event'	= event-				{ eventLastStarted	= Just startTime-				, eventLastEnded	= Just endTime }+                let event'      = event+                                { eventLastStarted      = Just startTime+                                , eventLastEnded        = Just endTime } -		let schedule'	= adjustEventOfSchedule event' schedule-	-		cronLoop schedule'-				-		-		-	+                let schedule'   = adjustEventOfSchedule event' schedule+        +                cronLoop schedule'+                                +                +                +        

@@ -2,79 +2,79 @@ -- | A gang consisting of a fixed number of threads that can run actions in parallel. --   Good for constructing parallel test frameworks. module BuildBox.Control.Gang-	( Gang-	, GangState(..)+        ( Gang+        , GangState(..) -	, forkGangActions-	, joinGang-	, pauseGang-	, resumeGang-	, flushGang-	, killGang-	-	, getGangState-	, waitForGangState)+        , forkGangActions+        , joinGang+        , pauseGang+        , resumeGang+        , flushGang+        , killGang+        +        , getGangState+        , waitForGangState) where import Control.Concurrent import Data.IORef-import qualified Data.Set	as Set-import Data.Set			(Set)+import qualified Data.Set       as Set+import Data.Set                 (Set)  -- Gang ----------------------------------------------------------------------- -- | Abstract gang of threads. data Gang-	= Gang -	{ gangThreads		:: Int-	, gangThreadsAvailable	:: QSemN-	, gangState		:: IORef GangState-	, gangActionsRunning	:: IORef Int -	, gangThreadsRunning	:: IORef (Set ThreadId) }+        = Gang +        { gangThreads           :: Int+        , gangThreadsAvailable  :: QSemN+        , gangState             :: IORef GangState+        , gangActionsRunning    :: IORef Int +        , gangThreadsRunning    :: IORef (Set ThreadId) }   data GangState-	= -- | Gang is running and starting new actions.-	  GangRunning+        = -- | Gang is running and starting new actions.+          GangRunning -	-- | Gang may be running already started actions, -	--   but no new ones are being started.-	| GangPaused+        -- | Gang may be running already started actions, +        --   but no new ones are being started.+        | GangPaused -	-- | Gang is waiting for currently running actions to finish, -	--   but not starting new ones.-	| GangFlushing+        -- | Gang is waiting for currently running actions to finish, +        --   but not starting new ones.+        | GangFlushing -	-- | Gang is finished, all the actions have completed.-	| GangFinished-	-	-- | Gang was killed, all the threads are dead (or dying).-	| GangKilled-	deriving (Show, Eq)+        -- | Gang is finished, all the actions have completed.+        | GangFinished+        +        -- | Gang was killed, all the threads are dead (or dying).+        | GangKilled+        deriving (Show, Eq)   -- | Get the state of a gang. getGangState :: Gang -> IO GangState getGangState gang-	= readIORef (gangState gang)+        = readIORef (gangState gang)   -- | Block until all actions have finished executing, --   or the gang is killed. joinGang :: Gang -> IO () joinGang gang- = do	state	<- readIORef (gangState gang)-	if state == GangFinished || state == GangKilled-	 then return ()-	 else do-		threadDelay 1000-		joinGang gang+ = do   state   <- readIORef (gangState gang)+        if state == GangFinished || state == GangKilled+         then return ()+         else do+                threadDelay 1000+                joinGang gang   -- | Block until already started actions have completed, but don't start any more. --   Gang state changes to `GangFlushing`. flushGang :: Gang -> IO () flushGang gang- = do	writeIORef (gangState gang) GangFlushing-	waitForGangState gang GangFinished+ = do   writeIORef (gangState gang) GangFlushing+        waitForGangState gang GangFinished   -- | Pause a gang. Actions that have already been started continue to run, @@ -82,34 +82,34 @@ --   Gang state changes to `GangPaused`. pauseGang :: Gang -> IO () pauseGang gang- 	= writeIORef (gangState gang) GangPaused+        = writeIORef (gangState gang) GangPaused   -- | Resume a paused gang, which allows it to continue starting new actions. --   Gang state changes to `GangRunning`. resumeGang :: Gang -> IO () resumeGang gang-	= writeIORef (gangState gang) GangRunning+        = writeIORef (gangState gang) GangRunning   -- | Kill all the threads in a gang. --   Gang stage changes to `GangKilled`. killGang :: Gang -> IO () killGang gang- = do	writeIORef (gangState gang) GangKilled-	tids	<- readIORef (gangThreadsRunning gang) -	mapM_ killThread $ Set.toList tids+ = do   writeIORef (gangState gang) GangKilled+        tids    <- readIORef (gangThreadsRunning gang) +        mapM_ killThread $ Set.toList tids   -- | Block until the gang is in the given state. waitForGangState :: Gang -> GangState -> IO () waitForGangState gang waitState- = do	state	<- readIORef (gangState gang)-	if state == waitState-	 then return ()-	 else do-		threadDelay 1000-		waitForGangState gang waitState+ = do   state   <- readIORef (gangState gang)+        if state == waitState+         then return ()+         else do+                threadDelay 1000+                waitForGangState gang waitState   -- | Fork a new gang to run the given actions.@@ -117,95 +117,95 @@ --   Gang state starts as `GangRunning` then transitions to `GangFinished`. --   To block until all the actions are finished use `joinGang`. forkGangActions-	:: Int 			-- ^ Number of worker threads in the gang \/ maximum number-				--   of actions to execute concurrenty.-	-> [IO ()] 		-- ^ Actions to run. They are started in-order, but may finish-				--   out-of-order depending on the run time of the individual action.-	-> IO Gang+        :: Int                  -- ^ Number of worker threads in the gang \/ maximum number+                                --   of actions to execute concurrenty.+        -> [IO ()]              -- ^ Actions to run. They are started in-order, but may finish+                                --   out-of-order depending on the run time of the individual action.+        -> IO Gang  forkGangActions threads actions- = do	semThreads		<- newQSemN threads-	refState		<- newIORef GangRunning-	refActionsRunning	<- newIORef 0-	refThreadsRunning	<- newIORef (Set.empty)-	let gang	-		= Gang-		{ gangThreads		= threads-		, gangThreadsAvailable	= semThreads -		, gangState 		= refState-		, gangActionsRunning	= refActionsRunning -		, gangThreadsRunning	= refThreadsRunning }+ = do   semThreads              <- newQSemN threads+        refState                <- newIORef GangRunning+        refActionsRunning       <- newIORef 0+        refThreadsRunning       <- newIORef (Set.empty)+        let gang        +                = Gang+                { gangThreads           = threads+                , gangThreadsAvailable  = semThreads +                , gangState             = refState+                , gangActionsRunning    = refActionsRunning +                , gangThreadsRunning    = refThreadsRunning } -	_ <- forkIO $ gangLoop gang actions-	return gang-	+        _ <- forkIO $ gangLoop gang actions+        return gang+          -- | Run actions on a gang. gangLoop :: Gang -> [IO ()] -> IO () gangLoop gang []- = do	-- Wait for all the threads to finish.-	waitQSemN -		(gangThreadsAvailable gang) -		(gangThreads gang)-		-	-- Signal that the gang is finished running actions.-	writeIORef (gangState gang) GangFinished+ = do   -- Wait for all the threads to finish.+        waitQSemN +                (gangThreadsAvailable gang) +                (gangThreads gang)+                +        -- Signal that the gang is finished running actions.+        writeIORef (gangState gang) GangFinished   gangLoop gang actions@(action:actionsRest)- = do	state	<- readIORef (gangState gang)-	case state of-	 GangRunning -	  -> do	-- Wait for a worker thread to become available.-		waitQSemN (gangThreadsAvailable gang) 1-		gangLoop_withWorker gang action actionsRest+ = do   state   <- readIORef (gangState gang)+        case state of+         GangRunning +          -> do -- Wait for a worker thread to become available.+                waitQSemN (gangThreadsAvailable gang) 1+                gangLoop_withWorker gang action actionsRest -	 GangPaused-	  -> do	threadDelay 1000-	 	gangLoop gang actions-			-	 GangFlushing-	  -> do	actionsRunning	<- readIORef (gangActionsRunning gang)-		if actionsRunning == 0-		 then	writeIORef (gangState gang) GangFinished-		 else do	-			threadDelay 1000-			gangLoop gang []+         GangPaused+          -> do threadDelay 1000+                gangLoop gang actions+                        +         GangFlushing+          -> do actionsRunning  <- readIORef (gangActionsRunning gang)+                if actionsRunning == 0+                 then   writeIORef (gangState gang) GangFinished+                 else do        +                        threadDelay 1000+                        gangLoop gang [] -	 GangFinished	-> return ()-	 GangKilled	-> return ()+         GangFinished   -> return ()+         GangKilled     -> return ()  -- we have an available worker gangLoop_withWorker :: Gang -> IO () -> [IO ()] -> IO () gangLoop_withWorker gang action actionsRest- = do	-- See if we're supposed to be starting actions or not.-	state	<- readIORef (gangState gang)-	case state of-	 GangRunning-	  -> do	-- fork off the first action-		tid <- forkOS $ do-			-- run the action (and wait for it to complete)-			action+ = do   -- See if we're supposed to be starting actions or not.+        state   <- readIORef (gangState gang)+        case state of+         GangRunning+          -> do -- fork off the first action+                tid <- forkOS $ do+                        -- run the action (and wait for it to complete)+                        action -			-- signal that a new worker is available-			signalQSemN (gangThreadsAvailable gang) 1-			-			-- remove our ThreadId from the set of running ThreadIds.-			tid	<- myThreadId-			atomicModifyIORef (gangThreadsRunning gang)-				(\tids -> (Set.delete tid tids, ()))-	-		-- Add the ThreadId of the freshly forked thread to the set-		-- of running ThreadIds. We'll need this set if we want to kill-		-- the gang.-		atomicModifyIORef (gangThreadsRunning gang)-			(\tids -> (Set.insert tid tids, ()))-	-		-- handle the rest of the actions.-		gangLoop gang actionsRest+                        -- signal that a new worker is available+                        signalQSemN (gangThreadsAvailable gang) 1+                        +                        -- remove our ThreadId from the set of running ThreadIds.+                        tid     <- myThreadId+                        atomicModifyIORef (gangThreadsRunning gang)+                                (\tids -> (Set.delete tid tids, ()))+        +                -- Add the ThreadId of the freshly forked thread to the set+                -- of running ThreadIds. We'll need this set if we want to kill+                -- the gang.+                atomicModifyIORef (gangThreadsRunning gang)+                        (\tids -> (Set.insert tid tids, ()))+        +                -- handle the rest of the actions.+                gangLoop gang actionsRest -	 -- someone issued flush or pause command while we-	 -- were waiting for a worker, so don't start next action.-	 _ -> do-		signalQSemN (gangThreadsAvailable gang) 1-		gangLoop gang (action:actionsRest)+         -- someone issued flush or pause command while we+         -- were waiting for a worker, so don't start next action.+         _ -> do+                signalQSemN (gangThreadsAvailable gang) 1+                gangLoop gang (action:actionsRest)

@@ -1,46 +1,46 @@  module BuildBox.Data.Comparison-	( -- * Comparisons-	  Comparison	(..)-	, makeComparison)+        ( -- * Comparisons+          Comparison    (..)+        , makeComparison) where import BuildBox.Pretty import Text.Printf   -- | The comparison of two values.-data Comparison a	-	-- | Comparison of a recent value with a baseline.-	= Comparison-	{ comparisonBaseline	:: a-	, comparisonRecent	:: a-	, comparisonSwing	:: Double }-	-	-- | A new value that doesn't have a baseline.-	| ComparisonNew-	{ comparisonNew		:: a }-	-	deriving (Read, Show)+data Comparison a       +        -- | Comparison of a recent value with a baseline.+        = Comparison+        { comparisonBaseline    :: a+        , comparisonRecent      :: a+        , comparisonSwing       :: Double }+        +        -- | A new value that doesn't have a baseline.+        | ComparisonNew+        { comparisonNew         :: a }+        +        deriving (Read, Show)  instance Pretty a => Pretty (Comparison a) where-	ppr (Comparison _ recent ratio)-		| abs ratio < 0.01	-		= text $ printf "%s (----)"-				(render $ ppr recent)+        ppr (Comparison _ recent ratio)+                | abs ratio < 0.01      +                = text $ printf "%s (----)"+                                (render $ ppr recent) -		| otherwise		-		= text $ printf "%s (%+4.0f)"-				(render $ ppr recent)-				(ratio * 100)+                | otherwise             +                = text $ printf "%s (%+4.0f)"+                                (render $ ppr recent)+                                (ratio * 100) -	ppr (ComparisonNew new)-		= (padL 10 $ ppr new)-		+        ppr (ComparisonNew new)+                = (padL 10 $ ppr new)+                  -- | Make a comparison from two values. makeComparison :: Real a => a -> a -> Comparison a makeComparison base recent-	= Comparison base recent swing-	where	dBase	= fromRational $ toRational base-		dRecent	= fromRational $ toRational recent-		swing = ((dRecent - dBase) / dBase)+        = Comparison base recent swing+        where   dBase   = fromRational $ toRational base+                dRecent = fromRational $ toRational recent+                swing = ((dRecent - dBase) / dBase)

@@ -1,63 +1,63 @@  -- | The detail is the name of an `Aspect` seprate from its data. module BuildBox.Data.Detail-	( Detail (..)-	, Timed	 (..)-	, Used	 (..)-	, Sized	 (..))+        ( Detail (..)+        , Timed  (..)+        , Used   (..)+        , Sized  (..)) where import BuildBox.Pretty  data Detail-	= DetailTimed Timed-	| DetailUsed   Used-	| DetailSized  Sized-	deriving (Eq, Ord, Show, Read)-	+        = DetailTimed Timed+        | DetailUsed   Used+        | DetailSized  Sized+        deriving (Eq, Ord, Show, Read)+          -- | Something that takes time to evaluate. data Timed-	= TotalWall-	| TotalCpu-	| TotalSys-	| KernelWall-	| KernelCpu -	| KernelSys-	deriving (Eq, Ord, Show, Read, Enum)-	+        = TotalWall+        | TotalCpu+        | TotalSys+        | KernelWall+        | KernelCpu +        | KernelSys+        deriving (Eq, Ord, Show, Read, Enum)+         instance Pretty Timed where  ppr timed   = case timed of-	TotalWall	-> text "runtime        (wall clock)"-	TotalCpu	-> text "runtime        (cpu usage)"-	TotalSys	-> text "runtime        (sys usage)"+        TotalWall       -> text "runtime        (wall clock)"+        TotalCpu        -> text "runtime        (cpu usage)"+        TotalSys        -> text "runtime        (sys usage)" -	KernelWall	-> text "kernel runtime (wall clock)"-	KernelCpu	-> text "kernel runtime (cpu usage)"-	KernelSys	-> text "kernel runtime (sys usage)"-		+        KernelWall      -> text "kernel runtime (wall clock)"+        KernelCpu       -> text "kernel runtime (cpu usage)"+        KernelSys       -> text "kernel runtime (sys usage)"+                  -- | Some resource used during execution. data Used-	= HeapMax-	| HeapAlloc-	deriving (Eq, Ord, Show, Read, Enum)-	+        = HeapMax+        | HeapAlloc+        deriving (Eq, Ord, Show, Read, Enum)+         instance Pretty Used where  ppr used   = case used of-	HeapMax		-> text "maximum heap usage"-	HeapAlloc	-> text "heap allocation"-	-	+        HeapMax         -> text "maximum heap usage"+        HeapAlloc       -> text "heap allocation"+        +         -- | Some static size of the benchmark that isn't affected during the run. data Sized-	= ExeSize-	deriving (Eq, Ord, Show, Read, Enum)-	+        = ExeSize+        deriving (Eq, Ord, Show, Read, Enum)+         instance Pretty Sized where  ppr sized   = case sized of-	ExeSize		-> text "executable size"-	-	+        ExeSize         -> text "executable size"+        +        

@@ -1,13 +1,13 @@  module BuildBox.Data.Dividable-	(Dividable(..))+        (Dividable(..)) where  class Dividable a where-	divide :: a -> a -> a-	+        divide :: a -> a -> a+         instance Dividable Integer where-	divide	= div+        divide  = div  instance Dividable Float where-	divide	= (/)+        divide  = (/)

@@ -2,28 +2,28 @@  -- | When the output of a command is long, keeping it as a `String` is a bad idea. module BuildBox.Data.Log-	( Log-	, Line-	, empty-	, null-	, toString-	, fromString-	, (<|)-	, (|>)-	, (><)-	, firstLines-	, lastLines)+        ( Log+        , Line+        , empty+        , null+        , toString+        , fromString+        , (<|)+        , (|>)+        , (><)+        , firstLines+        , lastLines) where-import Data.ByteString.Char8		(ByteString)-import Data.Sequence			(Seq)-import qualified Data.ByteString.Char8 	as BS-import qualified Data.Sequence		as Seq-import qualified Data.Foldable		as F-import Prelude				hiding (null)+import Data.ByteString.Char8            (ByteString)+import Data.Sequence                    (Seq)+import qualified Data.ByteString.Char8  as BS+import qualified Data.Sequence          as Seq+import qualified Data.Foldable          as F+import Prelude                          hiding (null)  -- | A sequence of lines, without newline charaters on the end.-type Log 	= Seq Line-type Line	= ByteString+type Log        = Seq Line+type Line       = ByteString   -- | O(1) No logs here.@@ -36,39 +36,39 @@  -- | O(n) Convert a `Log` to a `String`. toString :: Log -> String-toString ll	-	= BS.unpack -	$ BS.intercalate (BS.pack "\n") -	$ F.toList ll+toString ll     +        = BS.unpack +        $ BS.intercalate (BS.pack "\n") +        $ F.toList ll  -- | O(n) Convert a `String` to a `Log`. fromString :: String -> Log-fromString str	-	= Seq.fromList -	$ BS.splitWith (== '\n')-	$ BS.pack str+fromString str  +        = Seq.fromList +        $ BS.splitWith (== '\n')+        $ BS.pack str   -- | O(1) Add a `Line` to the start of a `Log`. (<|):: Line -> Log -> Log-(<|)	= (Seq.<|)+(<|)    = (Seq.<|)  -- | O(1) Add a `Line` to the end of a `Log`.-(|>)	:: Log -> Line -> Log-(|>)	= (Seq.|>)+(|>)    :: Log -> Line -> Log+(|>)    = (Seq.|>)  -- | O(log(min(n1,n2))) Concatenate two `Log`s.-(><)	:: Log -> Log -> Log-(><)	= (Seq.><)+(><)    :: Log -> Log -> Log+(><)    = (Seq.><)   -- | O(n) Take the first m lines from a log firstLines :: Int -> Log -> Log firstLines m ll-	= Seq.take m ll+        = Seq.take m ll  -- | O(n) Take the last m lines from a log lastLines :: Int -> Log -> Log lastLines m ll-	= Seq.drop (Seq.length ll - m) ll-	+        = Seq.drop (Seq.length ll - m) ll+        

@@ -1,25 +1,25 @@  module BuildBox.Data.Range-	( Range	(..)-	, makeRange-	, flattenRange)+        ( Range (..)+        , makeRange+        , flattenRange) where import BuildBox.Pretty import BuildBox.Data.Dividable  -- | A range extracted from many-valued data.-data Range a	-	= Range-	{ rangeMin	:: a-	, rangeAvg	:: a-	, rangeMax	:: a }-	deriving (Read, Show)+data Range a    +        = Range+        { rangeMin      :: a+        , rangeAvg      :: a+        , rangeMax      :: a }+        deriving (Read, Show)  instance Pretty a => Pretty (Range a) where-	ppr (Range mi av mx)-		=   (ppr mi) <+> text "/" -		<+> (ppr av) <+> text "/"-		<+> (ppr mx)+        ppr (Range mi av mx)+                =   (ppr mi) <+> text "/" +                <+> (ppr av) <+> text "/"+                <+> (ppr mx)  instance Functor Range where  fmap f (Range mi av mx)@@ -29,9 +29,9 @@ -- | Make statistics from a list of values. makeRange :: (Real a, Dividable a) => [a] -> Range a makeRange xs-	= Range (minimum xs)-		(sum xs `divide` (fromIntegral $ length xs)) -		(maximum xs)+        = Range (minimum xs)+                (sum xs `divide` (fromIntegral $ length xs)) +                (maximum xs)   -- | Flatten a `Range` into a list of its min, avg and max values.

@@ -3,112 +3,112 @@  -- | A schedule of commands that should be run at a certain time. module BuildBox.Data.Schedule-	( -	-- * Time Periods-	  second, minute, hour, day+        ( +        -- * Time Periods+          second, minute, hour, day -	-- * When-	, When		(..)-	, WhenModifier	(..)+        -- * When+        , When          (..)+        , WhenModifier  (..) -	-- * Events-	, EventName-	, Event		(..)-	, earliestEventToStartAt-	, eventCouldStartAt+        -- * Events+        , EventName+        , Event         (..)+        , earliestEventToStartAt+        , eventCouldStartAt -	-- * Schedules-	, Schedule	(..)-	, makeSchedule-	, lookupEventOfSchedule-	, lookupCommandOfSchedule-	, adjustEventOfSchedule-	, eventsOfSchedule)+        -- * Schedules+        , Schedule      (..)+        , makeSchedule+        , lookupEventOfSchedule+        , lookupCommandOfSchedule+        , adjustEventOfSchedule+        , eventsOfSchedule) where import Data.Time import Data.List import Data.Function import Data.Maybe import Control.Monad-import Data.Map			(Map)-import qualified Data.Map	as Map+import Data.Map                 (Map)+import qualified Data.Map       as Map  instance Read NominalDiffTime where  readsPrec n str-  = let	[(secs :: Double, rest)] = readsPrec n str-    in	case rest of-		's' : rest'	-> [(fromRational $ toRational secs, rest')]-		_		-> []+  = let [(secs :: Double, rest)] = readsPrec n str+    in  case rest of+                's' : rest'     -> [(fromRational $ toRational secs, rest')]+                _               -> []  second, minute, hour, day :: NominalDiffTime-second	= 1+second  = 1 minute  = 60-hour	= 60 * minute-day	= 24 * hour+hour    = 60 * minute+day     = 24 * hour   -- When ------------------------------------------------------------------------------------------- -- | When to invoke some event. data When-	-- | Just keep doing it.-	= Always+        -- | Just keep doing it.+        = Always -	-- | Don't do it, ever.-	| Never+        -- | Don't do it, ever.+        | Never -	-- | Do it some time after we last started it.-	| Every NominalDiffTime-	-	-- | Do it some time after it last finished.-	| After NominalDiffTime-	-	-- | Do it each day at this time. The ''days'' are UTC days, not local ones.-	| Daily TimeOfDay-	deriving (Read, Show, Eq)+        -- | Do it some time after we last started it.+        | Every NominalDiffTime+        +        -- | Do it some time after it last finished.+        | After NominalDiffTime+        +        -- | Do it each day at this time. The ''days'' are UTC days, not local ones.+        | Daily TimeOfDay+        deriving (Read, Show, Eq)   -- | Modifier to when. data WhenModifier-	-- | If the event hasn't been invoked before then do it immediately-	--   when we start the cron process.-	= Immediate+        -- | If the event hasn't been invoked before then do it immediately+        --   when we start the cron process.+        = Immediate -	-- | Wait until after this time before doing it first.-	| WaitUntil UTCTime-	deriving (Read, Show, Eq)+        -- | Wait until after this time before doing it first.+        | WaitUntil UTCTime+        deriving (Read, Show, Eq)   -- Event -------------------------------------------------------------------------------------------type EventName	= String+type EventName  = String  -- | Records when an event should start, and when it last ran. data Event-	= Event-	{ -- | A unique name for this event.-	  --   Used when writing the schedule to a file.-	  eventName		:: EventName+        = Event+        { -- | A unique name for this event.+          --   Used when writing the schedule to a file.+          eventName             :: EventName -	  -- | When to run the command.-	, eventWhen		:: When+          -- | When to run the command.+        , eventWhen             :: When -	  -- | Modifier to the previous.-	, eventWhenModifier	:: Maybe WhenModifier+          -- | Modifier to the previous.+        , eventWhenModifier     :: Maybe WhenModifier -	  -- | When the event was last started, if any.-	, eventLastStarted	:: Maybe UTCTime-		-	  -- | When the event last finished, if any.-	, eventLastEnded	:: Maybe UTCTime }-	deriving (Read, Show, Eq)-	+          -- | When the event was last started, if any.+        , eventLastStarted      :: Maybe UTCTime+                +          -- | When the event last finished, if any.+        , eventLastEnded        :: Maybe UTCTime }+        deriving (Read, Show, Eq)+          -- | Given the current time and a list of events, determine which one should be started now. --   If several events are avaliable then take the one with the earliest start time. earliestEventToStartAt :: UTCTime -> [Event] -> Maybe Event earliestEventToStartAt curTime events- = let	eventsStartable	= filter (eventCouldStartAt curTime)   events-	eventsSorted	= sortBy (compare `on` eventLastStarted) eventsStartable-   in	listToMaybe eventsSorted+ = let  eventsStartable = filter (eventCouldStartAt curTime)   events+        eventsSorted    = sortBy (compare `on` eventLastStarted) eventsStartable+   in   listToMaybe eventsSorted   -- | Given the current time, decide whether an event could be started.@@ -116,95 +116,95 @@ --   The `SkipFirst` modifier is ignored, as this is handled separately. eventCouldStartAt :: UTCTime -> Event -> Bool eventCouldStartAt curTime event-	-- If the event has never started or ended, and is marked as immediate,-	-- then start it right away.-	| Nothing		<- eventLastStarted  event-	, Nothing		<- eventLastEnded    event-	, Just Immediate	<- eventWhenModifier event-	= True+        -- If the event has never started or ended, and is marked as immediate,+        -- then start it right away.+        | Nothing               <- eventLastStarted  event+        , Nothing               <- eventLastEnded    event+        , Just Immediate        <- eventWhenModifier event+        = True -	-- If the current end time is before the start time, then the most-	-- recent iteration is still running, so don't start it again.-	| Just lastStarted	<- eventLastStarted event- 	, Just lastEnded	<- eventLastEnded   event- 	, lastEnded < lastStarted-	= False+        -- If the current end time is before the start time, then the most+        -- recent iteration is still running, so don't start it again.+        | Just lastStarted      <- eventLastStarted event+        , Just lastEnded        <- eventLastEnded   event+        , lastEnded < lastStarted+        = False -	-- Keep waiting if there's a seconday wait modifier.-	| Just (WaitUntil waitTime)	<- eventWhenModifier event-	, curTime < waitTime-	= False+        -- Keep waiting if there's a seconday wait modifier.+        | Just (WaitUntil waitTime)     <- eventWhenModifier event+        , curTime < waitTime+        = False -	-- Otherwise we have to look at the real schedule.-	| otherwise-	= case eventWhen event of-		Always		-> True-		Never		-> False+        -- Otherwise we have to look at the real schedule.+        | otherwise+        = case eventWhen event of+                Always          -> True+                Never           -> False -		Every diffTime	-	 	 -> maybe True-			(\lastTime -> (curTime `diffUTCTime` lastTime ) > diffTime)-			(eventLastStarted event)+                Every diffTime  +                 -> maybe True+                        (\lastTime -> (curTime `diffUTCTime` lastTime ) > diffTime)+                        (eventLastStarted event) -		After diffTime	-	 	 -> maybe True-			(\lastTime -> (curTime `diffUTCTime` lastTime ) > diffTime)-			(eventLastEnded event)-	-		Daily timeOfDay-		 -- If it's been less than a day since we last started it, then don't do it yet.-		 | Just lastStarted	<- eventLastStarted event-		 , (curTime `diffUTCTime` lastStarted) < day-		 -> False-		-		 | otherwise-		 -> let	-- If we were going to run it today, this is when it would be.-			startTimeToday-				= curTime-				{ utctDayTime	= timeOfDayToTime timeOfDay }-				-			-- If it's after that time then quit fooling around..-		    in	curTime > startTimeToday+                After diffTime  +                 -> maybe True+                        (\lastTime -> (curTime `diffUTCTime` lastTime ) > diffTime)+                        (eventLastEnded event)+        +                Daily timeOfDay+                 -- If it's been less than a day since we last started it, then don't do it yet.+                 | Just lastStarted     <- eventLastStarted event+                 , (curTime `diffUTCTime` lastStarted) < day+                 -> False+                +                 | otherwise+                 -> let -- If we were going to run it today, this is when it would be.+                        startTimeToday+                                = curTime+                                { utctDayTime   = timeOfDayToTime timeOfDay }+                                +                        -- If it's after that time then quit fooling around..+                    in  curTime > startTimeToday   -- Schedule ------------------------------------------------------------------------------------------ | Map of event names to their details and build commands.	+-- | Map of event names to their details and build commands.     data Schedule cmd-	= Schedule (Map EventName (Event, cmd))+        = Schedule (Map EventName (Event, cmd))   -- | Get the list of events in a schedule, ignoring the build commands. eventsOfSchedule :: Schedule cmd -> [Event] eventsOfSchedule (Schedule sched)-	= map fst $ Map.elems sched+        = map fst $ Map.elems sched   -- | A nice way to produce a schedule. makeSchedule :: [(EventName, When, Maybe WhenModifier, cmd)] -> Schedule cmd makeSchedule tuples- = let	makeSched (name, whn, mMod, cmd)-	  =	(name, (Event name whn mMod Nothing Nothing, cmd))-   in	Schedule $ Map.fromList $ map makeSched tuples+ = let  makeSched (name, whn, mMod, cmd)+          =     (name, (Event name whn mMod Nothing Nothing, cmd))+   in   Schedule $ Map.fromList $ map makeSched tuples   -- | Given an event name, lookup the associated event from a schedule. lookupEventOfSchedule :: EventName -> Schedule cmd -> Maybe Event lookupEventOfSchedule name (Schedule sched)-	= liftM fst $ Map.lookup name sched-	-	+        = liftM fst $ Map.lookup name sched+        +         -- | Given an event name, lookup the associated build command from a schedule. lookupCommandOfSchedule :: EventName -> Schedule cmd -> Maybe cmd lookupCommandOfSchedule name (Schedule sched)-	= liftM snd $ Map.lookup name sched+        = liftM snd $ Map.lookup name sched   -- | Given a new version of an event, update any matching event in the schedule. --   If the event not already there then return the original schedule. adjustEventOfSchedule :: Event -> Schedule cmd -> Schedule cmd adjustEventOfSchedule event (Schedule sched)-	= Schedule -	$ Map.adjust -		(\(_, build) -> (event, build))-		(eventName event) -		sched+        = Schedule +        $ Map.adjust +                (\(_, build) -> (event, build))+                (eventName event) +                sched

@@ -1,73 +1,73 @@  -- | Directory utils that don't need to be in the Build monad. module BuildBox.IO.Directory-	( lsFilesIn-	, lsDirsIn-	, traceFilesFrom)+        ( lsFilesIn+        , lsDirsIn+        , traceFilesFrom) where import System.Directory import Control.Monad import Control.Monad.Trans import Data.List-import Data.Sequence		(Seq)-import qualified Data.Sequence	as Seq+import Data.Sequence            (Seq)+import qualified Data.Sequence  as Seq   -- | Get the names of all files in a directory. --   This filters out the fake files like '.' and '..' lsFilesIn :: MonadIO m => String -> m [String] lsFilesIn path- = do 	contents <- liftIO $ getDirectoryContents path-	-	-- filter out directories-	files	<- filterM (\p -> liftM not $ liftIO $ doesDirectoryExist p) -		$ map (\f -> path ++ "/" ++ f)-		$ dropDotPaths contents+ = do   contents <- liftIO $ getDirectoryContents path+        +        -- filter out directories+        files   <- filterM (\p -> liftM not $ liftIO $ doesDirectoryExist p) +                $ map (\f -> path ++ "/" ++ f)+                $ dropDotPaths contents -	return	$ sort files+        return  $ sort files   -- | Get the names of all the dirs in this one. --   This filters out the fake files like '.' and '..'-lsDirsIn :: MonadIO m => String	 -> m [String]+lsDirsIn :: MonadIO m => String  -> m [String] lsDirsIn path  = do - 	contents <- liftIO $ getDirectoryContents path-	-	-- only keep directories-	dirs	<- filterM (liftIO . doesDirectoryExist)-		$  map (\f -> path ++ "/" ++ f)-		$  dropDotPaths contents+        contents <- liftIO $ getDirectoryContents path+        +        -- only keep directories+        dirs    <- filterM (liftIO . doesDirectoryExist)+                $  map (\f -> path ++ "/" ++ f)+                $  dropDotPaths contents -	return	$ sort dirs+        return  $ sort dirs   -- | Get all the files reachable from this directory traceFilesFrom :: FilePath -> IO (Seq FilePath) traceFilesFrom path- = do	isDir	<- doesDirectoryExist path-	isFile	<- doesFileExist      path+ = do   isDir   <- doesDirectoryExist path+        isFile  <- doesFileExist      path -	let result-		| isDir 	-		= do	contents <- liftM dropDotPaths-			 	 $  getDirectoryContents path+        let result+                | isDir         +                = do    contents <- liftM dropDotPaths+                                 $  getDirectoryContents path -			liftM (join  . Seq.fromList)-				$ mapM traceFilesFrom -				$ map (\f -> path ++ "/" ++ f) -				$ contents+                        liftM (join  . Seq.fromList)+                                $ mapM traceFilesFrom +                                $ map (\f -> path ++ "/" ++ f) +                                $ contents -		| isFile-		=	return	$ Seq.singleton path-		-		| otherwise-		=	return	$ Seq.empty-	-	result+                | isFile+                =       return  $ Seq.singleton path+                +                | otherwise+                =       return  $ Seq.empty+        +        result   -- | Drop out the fake '.' and '..' dirst from a list of paths. dropDotPaths :: [FilePath] -> [FilePath] dropDotPaths xx-	= filter (\f -> f /= "." && f /= "..") xx+        = filter (\f -> f /= "." && f /= "..") xx

@@ -1,15 +1,15 @@ {-# LANGUAGE ScopedTypeVariables, TypeSynonymInstances, FlexibleInstances,-             OverlappingInstances, IncoherentInstances #-}+             IncoherentInstances #-}  -- | Pretty printing utils. module BuildBox.Pretty-	( module Text.PrettyPrint-	, Pretty(..)-	, padRc, padR-	, padLc, padL-	, blank-	, pprEngDouble-	, pprEngInteger)+        ( module Text.PrettyPrint+        , Pretty(..)+        , padRc, padR+        , padLc, padL+        , blank+        , pprEngDouble+        , pprEngInteger) where import Text.PrettyPrint import Text.Printf@@ -18,52 +18,52 @@  -- Things that can be pretty printed class Pretty a where- 	ppr :: a -> Doc+        ppr :: a -> Doc  -- Basic instances instance Pretty Doc where-	ppr = id-	+        ppr = id+         instance Pretty Float where-	ppr = text . show+        ppr = text . show  instance Pretty Int where-	ppr = int-	+        ppr = int+         instance Pretty Integer where-	ppr = text . show+        ppr = text . show  instance Pretty UTCTime where-	ppr = text . show-	+        ppr = text . show+         instance Pretty a => Pretty [a] where-	ppr xx -		= lbrack <> (hcat $ punctuate (text ", ") (map ppr xx)) <> rbrack+        ppr xx +                = lbrack <> (hcat $ punctuate (text ", ") (map ppr xx)) <> rbrack  instance Pretty String where-	ppr = text+        ppr = text   -- | Right justify a doc, padding with a given character. padRc :: Int -> Char -> Doc -> Doc padRc n c str-	= (text $ replicate (n - length (render str)) c) <> str-	+        = (text $ replicate (n - length (render str)) c) <> str+          -- | Right justify a string with spaces. padR :: Int -> Doc -> Doc-padR n str	= padRc n ' ' str+padR n str      = padRc n ' ' str   -- | Left justify a string, padding with a given character. padLc :: Int -> Char -> Doc -> Doc padLc n c str-	= str <> (text $ replicate (n - length (render str)) c)+        = str <> (text $ replicate (n - length (render str)) c)   -- | Left justify a string with spaces. padL :: Int -> Doc -> Doc-padL n str	= padLc n ' ' str+padL n str      = padLc n ' ' str  -- | Blank text. This is different different from `empty` because it comes out a a newline when used in a `vcat`. blank :: Doc@@ -74,8 +74,8 @@ --   Good for units where fractional values might not make sense (like bytes). pprEngInteger :: String -> Integer -> Maybe Doc pprEngInteger unit k-    | k < 0	 = liftM (text "-" <>) $ pprEngInteger unit (-k)-    | k > 1000	 = pprEngDouble unit (fromRational $ toRational k)+    | k < 0      = liftM (text "-" <>) $ pprEngInteger unit (-k)+    | k > 1000   = pprEngDouble unit (fromRational $ toRational k)     | otherwise  = Just $ text $ printf "%5d%s " k unit  @@ -114,7 +114,7 @@     | k >= 1e-27 = Nothing     | otherwise  = Just $ text $ printf "%5.0f%s " k unit      where with (t :: Double) (u :: String)-		| t >= 1e3  = text $ printf "%.0f%s" t u-		| t >= 1e2  = text $ printf "%.1f%s" t u-		| t >= 1e1  = text $ printf "%.2f%s" t u-		| otherwise = text $ printf "%.3f%s" t u+                | t >= 1e3  = text $ printf "%.0f%s" t u+                | t >= 1e2  = text $ printf "%.1f%s" t u+                | t >= 1e1  = text $ printf "%.2f%s" t u+                | otherwise = text $ printf "%.3f%s" t u

@@ -1,82 +1,81 @@  -- | Time utils useful for writing buildbots. module BuildBox.Time-	( module Data.Time-	, readLocalTimeOfDayAsUTC-	, getStampyTime-	, getMidnightTodayLocal-	, getMidnightTodayUTC-	, getMidnightTomorrowLocal-	, getMidnightTomorrowUTC)+        ( module Data.Time+        , readLocalTimeOfDayAsUTC+        , getStampyTime+        , getMidnightTodayLocal+        , getMidnightTodayUTC+        , getMidnightTomorrowLocal+        , getMidnightTomorrowUTC) where import Data.Time-import System.Locale   -- | Read a time of day string like @17:34:05@ in the local time zone --   and convert that to a UTC time of day. Good for parsing command line args to buildbots. readLocalTimeOfDayAsUTC :: String -> IO TimeOfDay readLocalTimeOfDayAsUTC str- = do	-	-- Get the current timeZone.-	curTime	<- getZonedTime+ = do   +        -- Get the current timeZone.+        curTime <- getZonedTime -	-- Convert the time of day to what it would be as UTC.-	let (_, timeOfDayUTC)-		=  localToUTCTimeOfDay -			(zonedTimeZone curTime)-			(read str) +        -- Convert the time of day to what it would be as UTC.+        let (_, timeOfDayUTC)+                =  localToUTCTimeOfDay +                        (zonedTimeZone curTime)+                        (read str)  -	return timeOfDayUTC+        return timeOfDayUTC   -- | Get a local time stamp with format YYYYMMDD_HHMMSS. Good for naming files with. getStampyTime :: IO String getStampyTime- = do	time	<- getZonedTime-	return	$  formatTime defaultTimeLocale "%0Y%0m%0d_%0k%0M%0S" time+ = do   time    <- getZonedTime+        return  $  formatTime defaultTimeLocale "%0Y%0m%0d_%0k%0M%0S" time   -- | Get the local midnight we've just had as a `LocalTime`. getMidnightTodayLocal :: IO LocalTime getMidnightTodayLocal- = do	curTime	<- getZonedTime-	return	$ LocalTime-		{ localDay		= localDay $ zonedTimeToLocalTime curTime-		, localTimeOfDay	= midnight }+ = do   curTime <- getZonedTime+        return  $ LocalTime+                { localDay              = localDay $ zonedTimeToLocalTime curTime+                , localTimeOfDay        = midnight }   -- | Get the local midnight that we've just had, as a `UTCTime`. getMidnightTodayUTC :: IO UTCTime  getMidnightTodayUTC- = do	curTime	<- getZonedTime-	return	$ zonedTimeToUTC-		$ ZonedTime-			(LocalTime	-				{ localDay		= localDay $ zonedTimeToLocalTime curTime-				, localTimeOfDay	= midnight })-			(zonedTimeZone curTime)+ = do   curTime <- getZonedTime+        return  $ zonedTimeToUTC+                $ ZonedTime+                        (LocalTime      +                                { localDay              = localDay $ zonedTimeToLocalTime curTime+                                , localTimeOfDay        = midnight })+                        (zonedTimeZone curTime)   -- | Get the local midnight we're about to have as a `LocalTime`. getMidnightTomorrowLocal :: IO LocalTime getMidnightTomorrowLocal- = do	curTime	<- getZonedTime-	return	$ LocalTime-		{ localDay		= addDays 1 (localDay (zonedTimeToLocalTime curTime)) -		, localTimeOfDay	= midnight }+ = do   curTime <- getZonedTime+        return  $ LocalTime+                { localDay              = addDays 1 (localDay (zonedTimeToLocalTime curTime)) +                , localTimeOfDay        = midnight }  -- | Get the local midnight we're about to have as a `UTCTime`.-getMidnightTomorrowUTC 	 :: IO UTCTime+getMidnightTomorrowUTC   :: IO UTCTime getMidnightTomorrowUTC- = do	curTime	<- getZonedTime-	return	$ zonedTimeToUTC-		$ ZonedTime-		  	(LocalTime-				{ localDay		= addDays 1 (localDay (zonedTimeToLocalTime curTime)) -				, localTimeOfDay	= midnight })-			(zonedTimeZone curTime)+ = do   curTime <- getZonedTime+        return  $ zonedTimeToUTC+                $ ZonedTime+                        (LocalTime+                                { localDay              = addDays 1 (localDay (zonedTimeToLocalTime curTime)) +                                , localTimeOfDay        = midnight })+                        (zonedTimeZone curTime)  -	-	+        +        

@@ -1,5 +1,5 @@ Name:                buildbox-Version:             2.1.4.3+Version:             2.1.6.1 License:             BSD3 License-file:        LICENSE Author:              Ben Lippmeier@@ -17,21 +17,21 @@         Rehackable components for writing buildbots and test harnesses.  Tested-with:-        GHC == 7.8.2+        GHC == 7.0.3  Library   Build-Depends: -        base           >= 4.4 && < 4.8,+        base           >= 4.4 && < 4.9,         containers     >= 0.4 && < 0.6,-        time           >= 1.2 && < 1.5,+        time           >= 1.2 && < 1.6,         directory      >= 1.1 && < 1.3,         bytestring     >= 0.9 && < 0.11,-        mtl            == 2.2.*,-        old-locale     == 1.0.*,+        mtl            >= 2.2 && < 2.3,+        old-locale     >= 1.0 && < 1.1,         process        >= 1.2 && < 1.3,-        random         == 1.0.*,-        pretty         == 1.1.*,-        stm            == 2.4.*+        random         >= 1.0 && < 1.2,+        pretty         >= 1.1 && < 1.2,+        stm            >= 2.4 && < 2.5    ghc-options:         -Wall