4 import Control.Concurrent (forkIO, threadDelay)
5 import Control.Monad (forever, when)
6 import System.Exit (ExitCode(..), exitWith)
7 import System.IO (hPutStrLn, stderr)
15 exit_args_parse_failed :: Int
16 exit_args_parse_failed = 1
18 -- The length of all calls to sleep, in seconds.
22 thread_sleep :: Int -> IO ()
23 thread_sleep microseconds = do
24 let seconds = microseconds * (10 ^ (6 :: Int))
28 message_from_status :: Message -> Status -> Message
29 message_from_status message status =
30 message { subject = "Twat: " ++ (screen_name (user status)),
31 body = (pretty_print status) }
33 recurse :: String -> Integer -> (Maybe Message) -> IO ()
34 recurse username latest_status_id maybe_message = do
35 thread_sleep heartbeat
36 xmldata <- get_user_new_statuses username latest_status_id
38 -- Parsing an empty result can blow up. Just pretend there are
39 -- no new statuses in that case.
40 let new_statuses = case xmldata of
41 Just xml -> parse_statuses xml
44 case (length new_statuses) of
46 recurse username latest_status_id maybe_message
48 let new_latest_status_id = get_max_status_id new_statuses
49 mapM (putStrLn . pretty_print) new_statuses
53 recurse username new_latest_status_id maybe_message
56 let messages = map (message_from_status message) new_statuses
57 sendmail_results <- mapM sendmail messages
58 mapM print_sendmail_result sendmail_results
59 recurse username new_latest_status_id maybe_message
63 get_latest_status_id :: String -> IO Integer
64 get_latest_status_id username = do
65 xmldata <- get_user_timeline username
67 let initial_statuses = case xmldata of
68 Just xml -> parse_statuses xml
71 case (length initial_statuses) of
73 -- If the HTTP part barfs, try again after a while.
74 putStrLn ("Couldn't retrieve " ++ username ++ "'s timeline. Retrying...")
75 thread_sleep heartbeat
76 get_latest_status_id username
77 _ -> return (get_max_status_id initial_statuses)
81 run_twat :: Maybe Message -> String -> IO ()
82 run_twat message username = do
83 latest_status_id <- get_latest_status_id username
84 recurse username latest_status_id message
90 errors <- parse_errors
92 -- If there were errors parsing the command-line options,
93 -- print them and exit.
94 when (not (null errors)) $ do
95 hPutStrLn stderr (concat errors)
97 exitWith (ExitFailure exit_args_parse_failed)
99 -- Next, check to see if the 'help' option was passed to the
100 -- program. If it was, display the help, and exit successfully.
101 help_opt_set <- help_set
102 when help_opt_set $ do
106 usernames <- parse_usernames
108 -- If we have both a "To" and "From" address, we'll create a
109 -- message object to be passed to all of our threads.
110 to_address <- to_email_address
111 from_address <- from_email_address
112 let message = case to_address of
118 Just (Message { headers = [],
124 -- Execute run_twat on each username in a new thread.
125 mapM (forkIO . (run_twat message)) usernames
128 -- This thread (the one executing main) doesn't do anything,
129 -- but when it terminates, so do all the threads we forked.
130 -- As a result, we need to keep this thread on life support.
131 thread_sleep heartbeat