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, in seconds. heartbeat :: Int heartbeat = 600 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 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 let messages = map (message_from_status message) new_statuses sendmail_results <- mapM sendmail messages mapM print_sendmail_result sendmail_results recurse username new_latest_status_id maybe_message return () 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) 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 () 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 = [], 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 ()