src/Main.hs

   1 module Main
   2 where
   3
   4 import Control.Concurrent (forkIO, threadDelay)
   5 import Control.Monad (forever, when)
   6 import System.Exit (ExitCode(..), exitWith)
   7 import System.IO (hPutStrLn, stderr)
   8
   9 import CommandLine
  10 import Mail
  11 import Twitter.Http
  12 import Twitter.Status
  13 import Twitter.User
  14
  15 exit_args_parse_failed :: Int
  16 exit_args_parse_failed = 1
  17
  18 -- The length of all calls to sleep, in seconds.
  19 heartbeat :: Int
  20 heartbeat = 600
  21
  22 thread_sleep :: Int -> IO ()
  23 thread_sleep microseconds = do
  24   let seconds = microseconds * (10 ^ (6 :: Int))
  25   threadDelay seconds
  26
  27
  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) }
  32
  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
  37
  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
  42                          Nothing  -> []
  43
  44     case (length new_statuses) of
  45       0 ->
  46         recurse username latest_status_id maybe_message
  47       _ -> do
  48         let new_latest_status_id = get_max_status_id new_statuses
  49         mapM (putStrLn . pretty_print) new_statuses
  50
  51         case maybe_message of
  52           Nothing -> do
  53              recurse username new_latest_status_id maybe_message
  54              return ()
  55           Just message -> do
  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
  60              return ()
  61
  62
  63 get_latest_status_id :: String -> IO Integer
  64 get_latest_status_id username = do
  65   xmldata <- get_user_timeline username
  66
  67   let initial_statuses = case xmldata of
  68                            Just xml -> parse_statuses xml
  69                            Nothing -> []
  70
  71   case (length initial_statuses) of
  72     0 -> do
  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)
  78
  79
  80
  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
  85   return ()
  86
  87
  88 main :: IO ()
  89 main = do
  90   errors <- parse_errors
  91
  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)
  96       putStrLn help_text
  97       exitWith (ExitFailure exit_args_parse_failed)
  98
  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
 103       putStrLn help_text
 104       exitWith ExitSuccess
 105
 106   usernames <- parse_usernames
 107
 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
 113                   Nothing -> Nothing
 114                   Just toaddr ->
 115                       case from_address of
 116                         Nothing -> Nothing
 117                         Just fromaddr ->
 118                             Just (Message { headers = [],
 119                                             body = "",
 120                                             subject = "",
 121                                             to = toaddr,
 122                                             from = fromaddr })
 123
 124   -- Execute run_twat on each username in a new thread.
 125   mapM (forkIO . (run_twat message)) usernames
 126
 127   forever $ do
 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
 132
 133   return ()