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 03b7284665fa40b742cc6d36fa3a9209c2a6c838..2da56639667b4b2b63d387aaab601934091f5f7e 100644 (file)
--- 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,
---
---   <http://cr.yp.to/immhf/date.html>
---
--- 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 3ae09ebe9c9b484653bbf5ec85e71780a903de6c..5cd957bed71c80953d5df44c1af8cb05824d7633 100644 (file)
--- 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 976ccb31590c134bcaa766cd3d718a4bdf9dd454..01ef0ab04504596881188ebde26373281d42a1a3 100644 (file)
--- 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 96779ae666dccf7a400fa40c7f77b11f89ec1487..20abfbcc13195fc33eea5ab173a0ec46686a6ef4 100644 (file)
--- 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: