From: Michael Orlitzky Date: Sun, 11 Dec 2011 19:20:14 +0000 (-0500) Subject: Use the newer Data.Time library. X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=230072d26d55aed92737308aa04ce8a0daa0b71a;p=dead%2Fhalcyon.git Use the newer Data.Time library. Send mails with the "Date:" header set to the status' created_at time if possible. --- diff --git a/src/Mail.hs b/src/Mail.hs index 03b7284..2da5663 100644 --- a/src/Mail.hs +++ b/src/Mail.hs @@ -6,9 +6,10 @@ 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.Time (CalendarTime(..), ClockTime, getClockTime, Month, toCalendarTime) import System.IO (hClose, hGetContents, hPutStr) @@ -54,59 +55,12 @@ pad_left str n --- |Formats a month name according to RFC822. -format_month :: Month -> String -format_month month = take 3 (show month) - - --- |Takes an offset from UTC (in seconds) and returns the four-digit --- offset as a 'String' in +hhmm format. -format_timezone :: Int -> String -format_timezone seconds = - sign ++ pad_hh ++ pad_mm - where - seconds_norm = abs seconds - hh = seconds_norm `div` 3600 - mm = (seconds_norm - (hh*3600)) `div` 60 - pad_hh = pad_left (show hh) 2 - pad_mm = pad_left (show mm) 2 - sign = if seconds < 0 then "-" else "+" - - --- |Takes a 'ClockTime' as an argument, and formats it as an RFC822 Date header. --- --- See, --- --- --- --- for information. -format_clocktime :: ClockTime -> IO String -format_clocktime ct = do - caltime <- (toCalendarTime ct) - - let days = pad_left (show (ctDay caltime)) 2 - let month = format_month (ctMonth caltime) - let year = show $ ctYear caltime - let hours = pad_left (show (ctHour caltime)) 2 - let minutes = pad_left (show (ctMin caltime)) 2 - let seconds = pad_left (show (ctSec caltime)) 2 - let timezone = format_timezone (ctTZ caltime) - - return $ concat [(show $ ctWDay caltime) ++ ", ", - days ++ " ", - month ++ " ", - year ++ " ", - hours ++ ":", - minutes ++ ":", - seconds ++ " ", - timezone] - - --- |Constructs an RFC822 Date header with the current date/time. -construct_date_header :: IO String -construct_date_header = do - date <- getClockTime - format_clocktime date +-- | 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 diff --git a/src/Main.hs b/src/Main.hs index 3ae09eb..5cd957b 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -23,15 +23,20 @@ thread_sleep seconds = do threadDelay microseconds --- |Given a 'Message', 'Status', and date, update that message's body --- and subject with the information contained in the status. Adds a --- /Date: / header, and returns the updated message. +-- |Given a 'Message', 'Status', and default date, update that +-- message's body and subject with the information contained in the +-- status. Adds a /Date: / header, and returns the updated message. message_from_status :: Message -> String -> Status -> Message -message_from_status message date status = - message { subject = "Twat: " ++ (screen_name (user status)), - body = (pretty_print status), - headers = ((headers message) ++ ["Date: " ++ date])} - +message_from_status message default_date status = + message { subject = "Twat: " ++ (screen_name (user status)), + body = (pretty_print status), + headers = ((headers message) ++ ["Date: " ++ date])} + where + -- Use the Status' created_at date if it can be coerced into + -- RFC822 format. + date = case (created_at_to_rfc822 $ created_at status) of + Nothing -> default_date + Just c -> c -- |This is the main recursive loop. It takes a length of time to -- delay (in seconds), a username, a latest_status_id, and optionally @@ -63,8 +68,8 @@ recurse delay username latest_status_id maybe_message = do recurse delay username new_latest_status_id maybe_message return () Just message -> do - date_header <- construct_date_header - let messages = map (message_from_status message (date_header)) new_statuses + default_date <- rfc822_now + let messages = map (message_from_status message (default_date)) new_statuses sendmail_results <- mapM sendmail messages _ <- mapM print_sendmail_result sendmail_results recurse delay username new_latest_status_id maybe_message @@ -181,8 +186,8 @@ twat_single_status the_status_id maybe_message = do putStrLn "No message object given." return () Just message -> do - date_header <- construct_date_header - let messages = map (message_from_status message (date_header)) statuses + default_date <- rfc822_now + let messages = map (message_from_status message (default_date)) statuses sendmail_results <- mapM sendmail messages _ <- mapM print_sendmail_result sendmail_results return () diff --git a/src/Twitter/Status.hs b/src/Twitter/Status.hs index 976ccb3..01ef0ab 100644 --- a/src/Twitter/Status.hs +++ b/src/Twitter/Status.hs @@ -4,6 +4,8 @@ where import Data.Maybe import Data.String.Utils (join, splitWs) +import Data.Time (ZonedTime, formatTime, readsTime) +import System.Locale (defaultTimeLocale, rfc822DateFormat) import Test.HUnit import Text.Regex (matchRegex, mkRegex) import Text.XML.HaXml @@ -91,6 +93,21 @@ parse_statuses xml_data = xml_file_name :: String xml_file_name = "" + +created_at_to_rfc822 :: String -> Maybe String +created_at_to_rfc822 s = + case reads_result of + [(t,_)] -> + Just $ formatTime defaultTimeLocale rfc822DateFormat t + _ -> Nothing + where + -- Should match e.g. "Sun Oct 24 18:21:41 +0000 2010" + fmt :: String + fmt = "%a %b %d %H:%M:%S %z %Y" + + reads_result :: [(ZonedTime, String)] + reads_result = readsTime defaultTimeLocale fmt s + -- |Returns a nicely-formatted String representing the given 'Status' -- object. pretty_print :: Status -> String diff --git a/twat.cabal b/twat.cabal index 96779ae..20abfbc 100644 --- a/twat.cabal +++ b/twat.cabal @@ -15,8 +15,9 @@ executable twat HUnit == 1.2.*, MissingH == 1.*, process == 1.*, - old-time == 1.*, - regex-compat == 0.* + old-locale == 1.*, + regex-compat == 0.*, + time == 1.2.* main-is: