buildbot: add cmd for sending test mails
authorbenl@ouroborus.net <unknown>
Fri, 12 Nov 2010 02:48:38 +0000 (02:48 +0000)
committerbenl@ouroborus.net <unknown>
Fri, 12 Nov 2010 02:48:38 +0000 (02:48 +0000)
dph-buildbot/dph-builbot.cabal
dph-buildbot/src/Args.hs
dph-buildbot/src/BuildTest.hs
dph-buildbot/src/Config.hs
dph-buildbot/src/Main.hs

index c115c26..2463d59 100644 (file)
@@ -16,10 +16,10 @@ Synopsis:            DPH Performance regression build bot.
 Executable dph-buildbot
   Build-depends: 
         base                == 4.*,
-        directory           >= 1.0    && <= 1.2,
-        time                >= 1.1    && <= 1.3,
+        directory           >= 1.0    && < 1.2,
+        time                >= 1.1    && < 1.3,
         parseargs           == 0.1.*,
-        buildbox            == 1.3.*,
+        buildbox            >= 1.3.1  && < 1.4,
         mtl                 == 1.1.*,
         random              == 1.*
 
index 24751fc..9d58fcd 100644 (file)
@@ -31,6 +31,7 @@ data BuildArg
        | ArgTestIterations
        | ArgMailFrom 
        | ArgMailTo
+       | ArgSendTestMail
        | ArgWriteResults
        | ArgWriteResultsStamped
        | ArgAgainstResults
@@ -52,7 +53,6 @@ buildArgs
                , argData       = Nothing
                , argDesc       = "Verbose logging of build commands." }
 
-
        -- Automated builds
        , Arg   { argIndex      = ArgDaily
                , argAbbr       = Nothing
@@ -155,7 +155,7 @@ buildArgs
                , argDesc       = "(opt. for test modes) Write results to this file." }
 
        , Arg   { argIndex      = ArgWriteResultsStamped
-               , argAbbr       = Just 's'
+               , argAbbr       = Just 'p'
                , argName       = Just "write-stamped"
                , argData       = argDataOptional "file" ArgtypeString
                , argDesc       = "(opt. for test modes)  ... appending a time stamp to the name." }            
@@ -164,11 +164,18 @@ buildArgs
                , argAbbr       = Nothing
                , argName       = Just "mailfrom"
                , argData       = argDataOptional "address" ArgtypeString
-               , argDesc       = "(opt. for test modes) Use \"msmtp\" to mail results from this address." }
+               , argDesc       = "(opt. for test modes) Send test results from this address." }
 
        , Arg   { argIndex      = ArgMailTo
                , argAbbr       = Nothing
                , argName       = Just "mailto"
                , argData       = argDataOptional "address" ArgtypeString
                , argDesc       = "(opt. for test modes)  ... to this address." }                       
+
+       -- Setup debugging
+       , Arg   { argIndex      = ArgSendTestMail
+               , argAbbr       = Nothing
+               , argName       = Just "send-test-mail"
+               , argData       = Nothing
+               , argDesc       = "Send a test mail to check mailer configuration." }
        ]
index fa22e20..46a5bce 100644 (file)
@@ -9,22 +9,6 @@ import BuildBox
 import Data.Maybe
 import Control.Monad
 
-data BuildResults
-       = BuildResults
-       { buildResultTime               :: UTCTime
-       , buildResultEnvironment        :: Environment
-       , buildResultBench              :: [BenchResult Single] }
-       deriving (Show, Read)
-
-instance Pretty BuildResults where
- ppr results
-       = hang (ppr "BuildResults") 2 $ vcat
-       [ ppr "time: " <> (ppr $ buildResultTime results)
-       , ppr $ buildResultEnvironment results
-       , ppr ""
-       , vcat  $ punctuate (ppr "\n") 
-               $ map ppr 
-               $ buildResultBench results ]
 
 -- | Run regression tests.     
 buildTest :: Config -> Environment -> Build ()
@@ -124,7 +108,7 @@ buildTest config env
                                , blank ]
                        
                        outLn $ "  - Writing mail file"
-                       io $ writeFile "repa-bot.mail" $ render $ renderMail mail
+                       io $ writeFile "dph-buildbot.mail" $ render $ renderMail mail
                                
                        outLn $ "  - Sending mail"
                        sendMailWithMailer mail defaultMailer                           
index 26f6679..d1ef9a0 100644 (file)
@@ -56,8 +56,8 @@ data Config
 defaultMailer :: Mailer
 defaultMailer
        = MailerMSMTP
-       { mailerPath    = "msmtp"
-       , mailerPort    = Just 587 }
+       { mailerPath            = "msmtp"
+       , mailerPort            = Just 587 }
        
 
 -- Slurp ------------------------------------------------------------------------------------------
@@ -153,4 +153,3 @@ slurpConfig args
                                                = Nothing
                                                in      result
                }
-       
\ No newline at end of file
index a7c2766..a39da28 100644 (file)
@@ -35,6 +35,23 @@ mainWithArgs args
        -- Print usage help
        | gotArg args ArgHelp
        = usageError args ""
+
+       -- Send a test mail
+       | gotArg args ArgSendTestMail
+       = successfully . runBuildPrint "/tmp"
+       $ do    outLn "Sending test mail."
+               let from        = fromMaybe (error "you must specify --mailfrom with --send-test-mail")
+                                           (getArg args ArgMailFrom) 
+       
+               let to          = fromMaybe (error "you must specify --mailto with --send-test-mail")
+                                           (getArg args ArgMailTo)
+                               
+               mail    <- createMailWithCurrentTime from to "DDC BuildBot test mail" "Looks like it worked..."
+               sendMailWithMailer mail defaultMailer
+               
+               io $ writeFile "dph-buildbot.mail" (render $ renderMail mail)
+               return ()
+
        
        -- Run some build process.
        | (or $ map (gotArg args)