module Main 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) import CommandLine import ExitCodes import Mail import Twitter.Http import Twitter.Status import Twitter.User -- |A wrapper around threadDelay which takes seconds instead of -- microseconds as its argument. thread_sleep :: Int -> IO () 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 -- no new statuses in that case. let new_statuses = case xmldata of Just xml -> parse_statuses xml Nothing -> [] case (length new_statuses) of 0 -> 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 delay username new_latest_status_id maybe_message return () Just message -> do 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 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 :: Int -> String -> IO Integer get_latest_status_id delay username = do xmldata <- get_user_timeline username let initial_statuses = case xmldata of Just xml -> parse_statuses xml Nothing -> [] case (length initial_statuses) of 0 -> do -- If the HTTP part barfs, try again after a while. putStrLn ("Couldn't retrieve " ++ username ++ "'s timeline. Retrying...") thread_sleep delay get_latest_status_id delay username _ -> return (get_max_status_id initial_statuses) -- |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 -- If there were errors parsing the command-line options, -- print them and exit. when (not (null errors)) $ do hPutStrLn stderr (concat errors) putStrLn help_text exitWith (ExitFailure exit_args_parse_failed) -- Next, check to see if the 'help' option was passed to the -- program. If it was, display the help, and exit successfully. help_opt_set <- help_set when help_opt_set $ do putStrLn help_text exitWith ExitSuccess usernames <- parse_usernames -- If we have both a "To" and "From" address, we'll create a -- message object to be passed to all of our threads. to_address <- to_email_address from_address <- from_email_address let message = case to_address of Nothing -> Nothing Just toaddr -> case from_address of Nothing -> Nothing Just fromaddr -> 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 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 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 ()