X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=blobdiff_plain;f=src%2FMail.hs;h=3f519ccd8f0d0e22714a248a6595af378ca947eb;hp=8c1f25c89874eae68547f8323387b6116223419e;hb=d7c6b5499c0969b6e488d9fc583f93bbb4e3d4c7;hpb=dd6cea3dc5e830691b1da442fcf91602e4cf94aa diff --git a/src/Mail.hs b/src/Mail.hs index 8c1f25c..3f519cc 100644 --- a/src/Mail.hs +++ b/src/Mail.hs @@ -1,16 +1,22 @@ -- |Email functions and data types. -module Mail +module Mail ( + Message(..), + default_headers, + print_sendmail_result, + rfc822_now, + sendmail ) where -import Control.Concurrent -import Control.Exception (evaluate) -import Data.List (intercalate) -import Data.Time (formatTime, getZonedTime) -import System.Exit -import System.Locale (defaultTimeLocale, rfc822DateFormat) -import System.Process -import System.IO (hClose, hGetContents, hPutStr) +import Control.Concurrent ( forkIO, newEmptyMVar, putMVar, readMVar ) +import Control.Exception ( evaluate ) +import Control.Monad ( liftM ) +import Data.List ( intercalate ) +import Data.Time ( formatTime, getZonedTime ) +import System.Exit ( ExitCode(..) ) +import System.Locale ( defaultTimeLocale, rfc822DateFormat ) +import System.Process ( runInteractiveProcess, waitForProcess ) +import System.IO ( hClose, hGetContents, hPutStr ) type Header = String @@ -49,22 +55,13 @@ instance Show Message where else (intercalate "\n" (headers m)) ++ "\n" --- |Pad a string on the left with zeros until the entire string has --- length n. -pad_left :: String -> Int -> String -pad_left str n - | n < (length str) = str - | otherwise = (replicate num_zeros '0') ++ str - where num_zeros = n - (length str) - - -- | Constructs a 'String' in RFC822 date format for the current -- date/time. rfc822_now :: IO String -rfc822_now = do - date <- getZonedTime - return $ formatTime defaultTimeLocale rfc822DateFormat date +rfc822_now = + liftM (formatTime defaultTimeLocale rfc822DateFormat) getZonedTime + @@ -100,7 +97,7 @@ sendmail sendmail_path message = do -- errors, and exit codes. This function pretty-prints one of those -- three-tuples. print_sendmail_result :: (String, String, ExitCode) -> IO () -print_sendmail_result (outs, errs, ec) = do +print_sendmail_result (outs, errs, ec) = case ec of ExitSuccess -> return () _ -> putStrLn $ concat ["Output: " ++ outs,