X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=blobdiff_plain;f=src%2FMain.hs;h=5cd957bed71c80953d5df44c1af8cb05824d7633;hp=f6fd170ed1c2073827e33522b675747581b9af83;hb=230072d26d55aed92737308aa04ce8a0daa0b71a;hpb=5f1220bd5d1b6893a4e2c0a179b3244a12eae6c8 diff --git a/src/Main.hs b/src/Main.hs index f6fd170..5cd957b 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -3,6 +3,7 @@ where import Control.Concurrent (forkIO, threadDelay) import Control.Monad (forever, when) +import Data.Maybe (fromJust) import System.Exit (ExitCode(..), exitWith) import System.IO (hPutStrLn, stderr) @@ -14,10 +15,6 @@ import Twitter.Status import Twitter.User --- |The length of all calls to sleep (or threadDelay), in seconds. -heartbeat :: Int -heartbeat = 600 - -- |A wrapper around threadDelay which takes seconds instead of -- microseconds as its argument. thread_sleep :: Int -> IO () @@ -26,25 +23,31 @@ 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])} - - --- |This is the main recursive loop. It takes a username, a --- latest_status_id, and optionally a 'Message' as arguments. The --- latest_status_id is the last status (that we know of) to be posted --- to username's Twitter account. If we find any newer statuses when --- we check, they are printed and optionally emailed (if a 'Message' --- was supplied). Then, the process repeats. -recurse :: String -> Integer -> (Maybe Message) -> IO () -recurse username latest_status_id maybe_message = do - thread_sleep heartbeat +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 +-- a 'Message' as arguments. The latest_status_id is the last status +-- (that we know of) to be posted to username's Twitter account. If we +-- find any newer statuses when we check, they are printed and +-- optionally emailed (if a 'Message' was supplied). Then, the process +-- repeats. +recurse :: Int -> String -> Integer -> (Maybe Message) -> IO () +recurse delay username latest_status_id maybe_message = do + thread_sleep delay xmldata <- get_user_new_statuses username latest_status_id -- Parsing an empty result can blow up. Just pretend there are @@ -55,28 +58,28 @@ recurse username latest_status_id maybe_message = do case (length new_statuses) of 0 -> - recurse username latest_status_id maybe_message + recurse delay username latest_status_id maybe_message _ -> do let new_latest_status_id = get_max_status_id new_statuses _ <- mapM (putStrLn . pretty_print) new_statuses case maybe_message of Nothing -> do - recurse username new_latest_status_id maybe_message + 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 username new_latest_status_id maybe_message + recurse delay username new_latest_status_id maybe_message return () -- |Try continually to download username's timeline, and determine the -- latest status id to be posted once we have done so. -get_latest_status_id :: String -> IO Integer -get_latest_status_id username = do +get_latest_status_id :: Int -> String -> IO Integer +get_latest_status_id delay username = do xmldata <- get_user_timeline username let initial_statuses = case xmldata of @@ -87,8 +90,8 @@ get_latest_status_id username = do 0 -> do -- If the HTTP part barfs, try again after a while. putStrLn ("Couldn't retrieve " ++ username ++ "'s timeline. Retrying...") - thread_sleep heartbeat - get_latest_status_id username + thread_sleep delay + get_latest_status_id delay username _ -> return (get_max_status_id initial_statuses) @@ -98,10 +101,10 @@ get_latest_status_id username = do -- recursive loop that checks for updates forever. The message -- argument is optional and is passed to recurse in case the updates -- should be emailed. -run_twat :: Maybe Message -> String -> IO () -run_twat message username = do - latest_status_id <- get_latest_status_id username - recurse username latest_status_id message +run_twat :: Int -> Maybe Message -> String -> IO () +run_twat delay message username = do + latest_status_id <- get_latest_status_id delay username + recurse delay username latest_status_id message return () @@ -144,13 +147,47 @@ main = do to = toaddr, from = fromaddr }) + -- This should be safe since we checked for parse errors earlier. + delay <- fmap fromJust heartbeat + -- Execute run_twat on each username in a new thread. - _ <- mapM (forkIO . (run_twat message)) usernames + _ <- mapM (forkIO . (run_twat delay message)) usernames _ <- forever $ do -- This thread (the one executing main) doesn't do anything, -- but when it terminates, so do all the threads we forked. -- As a result, we need to keep this thread on life support. - thread_sleep heartbeat + thread_sleep delay return () + + +-- |A debugging tool that will parse, print, and email a single status +-- (given by its id). +twat_single_status :: Integer -> (Maybe Message) -> IO () +twat_single_status the_status_id maybe_message = do + xmldata <- get_status the_status_id + + -- Parsing an empty result can blow up. Just pretend there are + -- no new statuses in that case. + let statuses = case xmldata of + Just xml -> parse_status xml + Nothing -> [] + + case (length statuses) of + 0 -> do + putStrLn "No statuses returned." + return () + _ -> do + _ <- mapM (putStrLn . pretty_print) statuses + + case maybe_message of + Nothing -> do + putStrLn "No message object given." + return () + Just message -> do + 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 ()