darcswatch 0.4.2 → 0.4.3

raw patch · 2 files changed

+77/−1 lines, 2 files

Files

• darcswatch.cabal +2/−1
• src/Darcs/Watch/Mail.hs +75/−0

@@ -1,5 +1,5 @@ Name:            darcswatch-version:         0.4.2+version:         0.4.3 Category:        Distribution name:            darcswatch author:          Joachim Breitner@@ -59,6 +59,7 @@                         , Darcs.Watch.ImportMail                         , Darcs.Watch.UpdateRepoData                         , Darcs.Watch.Storage+                        , Darcs.Watch.Mail         Build-Depends:  base > 3 && < 4                         , network                         , HTTP >= 4000

@@ -0,0 +1,75 @@+module Darcs.Watch.Mail where++import Codec.MIME.String as MIME+import Data.List+import System.IO+import System.Exit+import System.Process+import Control.Monad+import Data.Maybe+import Data.Char+import qualified Data.ByteString.Char8 as B++import Darcs.Watch.Data+import Darcs+import HTML++mailSubscriptions :: DarcsWatchConfig -> RepositoryURL -> BundleHash -> PatchBundle -> [BundleHistory] -> BundleState -> IO ()+mailSubscriptions _      _    _          _      _       status+	| status `notElem` [Applied] = return ()+mailSubscriptions config repo bundleHash bundle history status = +	forM_ (map snd (filter (\(r,m) -> r == repo) (cRepoSubscriptions config))) $ \to -> do+		message <- flatten [mk_header ["From: " ++ from]+				   ,mk_header ["To: " ++ to]+				   ,mk_header ["References: " ++ unwords references]+				   ,mk_header ["Subject: " ++ subject]+				   ] body Nothing []+		if cSendMails config+		  then do sendMail message+		  else do hPutStrLn stderr "Would send this message:"+			  hPutStrLn stderr message+  where from = cDarcsWatchAddress config+	subject = case status of+		   Applied -> case mapMaybe extractSubject history of +			[] -> "Applied: Patch bundle"+		   	sj -> "Applied: " ++ fixUpSubject (last sj)+	body = case status of+		Applied ->    "This " +++			       (if length (fst bundle) ==  1+			       	then "1-patch"+				else show (length (fst bundle)) ++ "-patches") ++ +			       " bundle was just applied to " ++ repo +++			      ":\n\n" +++			      concatMap showPatch (fst bundle) +++			      "\n-- \n" +++			      "This message was brought to you by DarcsWatch\n" +++			      bundleURL config repo bundleHash+        numPatches = length (fst bundle)+	references = mapMaybe extractMessageId history+	showPatch (pi,_) =+		B.unpack (piDate pi) ++ "  " ++ B.unpack (piAuthor pi) ++ "\n" +++		" * " ++ B.unpack (piName pi) ++ "\n" +++		unlines (map ((' ':). B.unpack) (stripIgnorethis (piLog pi))) +++		"\n"++sendMail ::  String -> IO ()+sendMail text = do+      (inh, outh, errh, ph) <- runInteractiveProcess "/usr/sbin/sendmail" ["-t"] Nothing Nothing+      hClose outh+      hPutStr inh text+      hClose inh+      err <- hGetContents errh+      hPutStr stderr err+      ec <- waitForProcess ph+      return ()++extractMessageId (_,ViaEMail _ _ _ (Just mid),_) = Just mid+extractMessageId  _                              = Nothing++extractSubject (_,ViaEMail _ _ subject _,_) = Just subject+extractSubject _                            = Nothing++fixUpSubject = dropWhile isSpace . dropBrackets . dropWhile isSpace++dropBrackets ('[':xs) = case dropWhile (/=']') xs of { "" -> ""; r -> tail r}+dropBrackets xs     = xs