module Main where import Control.Concurrent (forkIO, threadDelay) import Control.Monad (forever, when) 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 -- |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 () thread_sleep seconds = do let microseconds = seconds * (10 ^ (6 :: Int)) 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. 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 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 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 return () Just message -> do date_header <- construct_date_header let messages = map (message_from_status message (date_header)) new_statuses sendmail_results <- mapM sendmail messages mapM print_sendmail_result sendmail_results recurse 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 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 heartbeat get_latest_status_id 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 :: Maybe Message -> String -> IO () run_twat message username = do latest_status_id <- get_latest_status_id username recurse 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 }) -- Execute run_twat on each username in a new thread. mapM (forkIO . (run_twat 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 return ()