buildbox 2.1.9.3 → 2.1.9.4

raw patch · 6 files changed

+60/−54 lines, 6 filesdep ~basedep ~exceptionsdep ~temporaryPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, exceptions, temporary

API changes (from Hackage documentation)

Files

• BuildBox/Build/BuildError.hs +7/−6
• BuildBox/Command/Environment.hs +20/−19
• BuildBox/Command/Mail.hs +8/−7
• BuildBox/Command/System.hs +14/−13
• BuildBox/Pretty.hs +7/−5
• buildbox.cabal +4/−4

@@ -10,6 +10,7 @@ import System.Exit import BuildBox.Data.Log                (Log) import qualified BuildBox.Data.Log      as Log+import Prelude  hiding ((<>))   -- BuildError -------------------------------------------------------------------------------------@@ -24,12 +25,12 @@                 , 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  +        | 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.@@ -37,9 +38,9 @@         deriving Typeable  instance Exception BuildError-          + instance Pretty BuildError where  ppr err   = case err of@@ -47,11 +48,11 @@          -> text "Other error: " <> text str          ErrorSystemCmdFailed{}-         -> vcat +         -> vcat          $      [ text "System command failure."                 , text "    command: " <> (text $ buildErrorCmd err)                 , text "  exit code: " <> (text $ show $ buildErrorCode err)-                , blank ] +                , blank ]           ++ (if (not $ Log.null $ buildErrorStdout err)              then [ text "-- stdout (last 10 lines) ------------------------------------------------------"@@ -67,7 +68,7 @@                || (not $ Log.null $ buildErrorStderr err))              then [ text "--------------------------------------------------------------------------------" ]              else [])-        +         ErrorIOError ioerr          -> text "IO error: " <> (text $ show ioerr) 

@@ -4,7 +4,7 @@         ( -- * Build Environment           Environment(..)         , getEnvironmentWith-        +           -- * Build platform         , Platform(..)         , getHostPlatform@@ -13,7 +13,7 @@         , getHostProcessor         , getHostOS         , getHostRelease-        +           -- * Software versions         , getVersionGHC         , getVersionGCC)@@ -22,11 +22,12 @@ import BuildBox.Command.System import BuildBox.Command.File import BuildBox.Pretty+import Prelude  hiding ((<>))   -- Environment ------------------------------------------------------------------------------------ -- | The environment consists of the `Platform`, and some tool versions.-data Environment +data Environment         = Environment         { environmentPlatform   :: Platform         , environmentVersions   :: [(String, String)] }@@ -37,32 +38,32 @@  ppr env         = hang (ppr "Environment") 2 $ vcat         [ ppr   $ environmentPlatform env-        , hang (ppr "Versions") 2 -                $ vcat -                $ map (\(name, ver) -> ppr name <+> ppr ver) +        , hang (ppr "Versions") 2+                $ vcat+                $ map (\(name, ver) -> ppr name <+> ppr ver)                 $ environmentVersions env ]    -- | Get the current environment, including versions of these tools.-getEnvironmentWith +getEnvironmentWith         :: [(String, Build String)]     -- ^ List of tool names and commands to get their versions.         -> Build Environment-        -getEnvironmentWith nameGets ++getEnvironmentWith nameGets  = do   platform        <- getHostPlatform          versions        <- mapM (\(name, get) -> do                                         ver     <- get                                         return  (name, ver))                         $  nameGets-                        +         return  $ Environment-                { environmentPlatform   = platform +                { environmentPlatform   = platform                 , environmentVersions   = versions }-          + -- Platform --------------------------------------------------------------------------------------- -- | Generic information about the platform we're running on. data Platform@@ -73,8 +74,8 @@         , platformHostOS        :: String         , platformHostRelease   :: String }         deriving (Show, Read)-        -        ++ instance Pretty Platform where  ppr plat         = hang (ppr "Platform") 2 $ vcat@@ -86,21 +87,21 @@  -- | Get information about the host platform. getHostPlatform :: Build Platform-getHostPlatform +getHostPlatform  = 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@@ -149,8 +150,8 @@  = 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. ++-- | 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

@@ -1,5 +1,5 @@ --- | Sending email. +-- | Sending email. --   If you're on a system with a working @sendmail@ then use that. --   Otherwise, the stand-alone @msmtp@ server is easy to set up. --   Get @msmtp@ here: <http://msmtp.sourceforge.net>@@ -18,6 +18,7 @@ import Data.Time.LocalTime import Data.Time.Format import Data.Time.Calendar+import Prelude  hiding ((<>))   -- | An email message that we can send.@@ -56,7 +57,7 @@ --   Fill in the date and message id based on the current time. --   Valid dates and message ids are needed to prevent the mail --   being bounced by anti-spam systems.-createMailWithCurrentTime +createMailWithCurrentTime         :: String       -- ^ ''from'' field. Should be an email address.         -> String       -- ^ ''to'' field. Should be an email address.         -> String       -- ^ Subject line.@@ -76,7 +77,7 @@         let secTime     = utctDayTime utime         let messageId   =  "<" ++ show dayNum ++ "." ++ (init $ show secTime)                         ++ "@" ++ hostName ++ ">"-                +         return  $ Mail                 { mailFrom      = from                 , mailTo        = to@@ -106,19 +107,19 @@ sendMailWithMailer :: Mail -> Mailer -> Build () sendMailWithMailer mail mailer  = case mailer of-        MailerSendmail{}        +        MailerSendmail{}          -> ssystemTee False                 (mailerPath mailer                         ++ " -t ") -- read recipients from the mail                 (render $ renderMail mail) -        MailerMSMTP{}   +        MailerMSMTP{}          -> ssystemTee False-                (mailerPath mailer +                (mailerPath mailer                         ++ " -t " -- read recipients from the mail                         ++ (maybe "" (\port -> " --port=" ++ show port) $ mailerPort mailer))                 (render $ renderMail mail)-                +   

@@ -1,13 +1,13 @@ {-# LANGUAGE PatternGuards, BangPatterns #-} --- | Running system commands. On some platforms this may cause the command to be executed directly, so +-- | Running system commands. On some platforms this may cause the command to be executed directly, so --   shell tricks won't work. The `Build` monad can be made to log commands executed with all versions --   of `system` by setting `buildConfigLogSystem` in the `BuildConfig` passed to `runBuildPrintWithConfig`. -----   We define a lot of wrappers because executing system commands is the bread-and-butter of +--   We define a lot of wrappers because executing system commands is the bread-and-butter of --   buildbots, and we usually need all the versions... -module BuildBox.Command.System +module BuildBox.Command.System         ( module System.Exit          -- * Wrappers@@ -47,7 +47,7 @@   -- Wrappers ------------------------------------------------------------------------------------------ | Run a system command, +-- | Run a system command, --   returning its exit code and what it wrote to @stdout@ and @stderr@. system :: String -> Build (ExitCode, String, String) system cmd@@ -64,7 +64,7 @@   --- | Run a successful system command, +-- | Run a successful system command, --   returning what it wrote to @stdout@ and @stderr@. --   If the exit code is `ExitFailure` then throw an error in the `Build` monad. ssystem :: String -> Build (String, String)@@ -91,7 +91,7 @@   -- | Run a successful system command, returning what it wrote to its @stdout@.---   If anything was written to @stderr@ then treat that as failure. +--   If anything was written to @stderr@ then treat that as failure. --   If it fails due to writing to @stderr@ or returning `ExitFailure` --   then throw an error in the `Build` monad. sesystem :: String -> Build String@@ -103,7 +103,7 @@         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. +--   If anything was written to @stderr@ then treat that as failure. --   If it fails due to writing to @stderr@ or returning `ExitFailure` --   then throw an error in the `Build` monad. sesystemq :: String -> Build String@@ -159,7 +159,7 @@         -- 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                 $  CreateProcess                         { cmdspec               = ShellCommand cmd                         , cwd                   = Nothing@@ -167,22 +167,23 @@                         , std_in                = CreatePipe                         , std_out               = CreatePipe                         , std_err               = CreatePipe-                        , close_fds             = False +                        , close_fds             = False                         , create_group          = False                         , delegate_ctlc         = False                         , detach_console        = False                         , create_new_console    = False                         , new_session           = False                         , child_group           = Nothing-                        , child_user            = Nothing }+                        , child_user            = Nothing+                        , use_process_jobs      = True }          -- 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. +        -- processes stdout and stderr and write them to these channels.         --      When they hit EOF they signal this via the semaphores.         chanOut         <- newTChanIO         chanErr         <- newTChanIO@@ -227,7 +228,7 @@         trace $ "systemTeeIO: All done"         hClose hOutRead         hClose hErrRead-        code `seq` logOut `seq` logErr `seq` +        code `seq` logOut `seq` logErr `seq`                 return  (code, logOut, logErr)  slurpChan :: TChan (Maybe ByteString) -> Log -> IO Log

@@ -15,7 +15,9 @@ import Text.Printf import Data.Time import Control.Monad+import Prelude  hiding ((<>)) + -- Things that can be pretty printed class Pretty a where         ppr :: a -> Doc@@ -23,21 +25,21 @@ -- Basic instances instance Pretty Doc where         ppr = id-        + instance Pretty Float where         ppr = text . show  instance Pretty Int where         ppr = int-        + instance Pretty Integer where         ppr = text . show  instance Pretty UTCTime where         ppr = text . show-        + instance Pretty a => Pretty [a] where-        ppr xx +        ppr xx                 = lbrack <> (hcat $ punctuate (text ", ") (map ppr xx)) <> rbrack  instance Pretty String where@@ -48,7 +50,7 @@ padRc :: Int -> Char -> Doc -> Doc padRc n c str         = (text $ replicate (n - length (render str)) c) <> str-        +  -- | Right justify a string with spaces. padR :: Int -> Doc -> Doc

@@ -1,5 +1,5 @@ Name:                buildbox-Version:             2.1.9.3+Version:             2.1.9.4 License:             BSD3 License-file:        LICENSE Author:              Ben Lippmeier@@ -21,7 +21,7 @@  Library   Build-Depends:-        base           >= 4.4 && < 4.10,+        base           >= 4.4 && < 4.12,         containers     >= 0.4 && < 0.6,         time           >= 1.2 && < 1.9,         directory      >= 1.1 && < 1.4,@@ -29,8 +29,8 @@         mtl            >= 2.2 && < 2.3,         old-locale     >= 1.0 && < 1.1,         process        >= 1.2 && < 1.7,-        temporary      >= 1.2 && < 1.3,-        exceptions     >= 0.8 && < 0.9,+        temporary      >= 1.2 && < 1.4,+        exceptions     >= 0.8 && < 0.11,         pretty         >= 1.1 && < 1.2,         stm            >= 2.4 && < 2.5,         text           >= 1.2 && < 1.3