X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=blobdiff_plain;f=src%2FMain.hs;h=5cd957bed71c80953d5df44c1af8cb05824d7633;hp=ac33b2bdc654ffe143e7aeaa548fc93413d64f63;hb=bfe49b970e83f1d422d57ece7cebdfe7a56b817c;hpb=53c26134670775854677470e402b8b41f19246d1 diff --git a/src/Main.hs b/src/Main.hs index ac33b2b..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,24 +15,39 @@ import Twitter.Status import Twitter.User --- The length of all calls to sleep, in seconds. -heartbeat :: Int -heartbeat = 600 - +-- |A wrapper around threadDelay which takes seconds instead of +-- microseconds as its argument. thread_sleep :: Int -> IO () -thread_sleep microseconds = do - let seconds = microseconds * (10 ^ (6 :: Int)) - threadDelay seconds - - -message_from_status :: Message -> Status -> Message -message_from_status message status = - message { subject = "Twat: " ++ (screen_name (user status)), - body = (pretty_print status) } - -recurse :: String -> Integer -> (Maybe Message) -> IO () -recurse username latest_status_id maybe_message = do - thread_sleep heartbeat +thread_sleep seconds = do + let microseconds = seconds * (10 ^ (6 :: Int)) + threadDelay microseconds + + +-- |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 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 @@ -42,25 +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 + _ <- 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 - let messages = map (message_from_status message) 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 + _ <- mapM print_sendmail_result sendmail_results + recurse delay username new_latest_status_id maybe_message return () -get_latest_status_id :: String -> IO Integer -get_latest_status_id username = do +-- |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 :: Int -> String -> IO Integer +get_latest_status_id delay username = do xmldata <- get_user_timeline username let initial_statuses = case xmldata of @@ -71,19 +90,27 @@ 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) -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 +-- |This function wraps two steps. First, we need to find the latest +-- status id posted by username. Once we have that, we can begin the +-- 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 :: 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 () +-- |The main function just parses the command-line arguments and then +-- forks off calls to 'run_twat' for each supplied username. After +-- forking, main loops forever. main :: IO () main = do errors <- parse_errors @@ -114,19 +141,53 @@ main = do case from_address of Nothing -> Nothing Just fromaddr -> - Just (Message { headers = [], + Just (Message { headers = default_headers, body = "", subject = "", 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 + _ <- 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 ()