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 ExitCodes
  11 import Mail
  12 import Twitter.Http
  13 import Twitter.Status
  14 import Twitter.User
  15
  16
  17 -- The length of all calls to sleep, in seconds.
  18 heartbeat :: Int
  19 heartbeat = 600
  20
  21 thread_sleep :: Int -> IO ()
  22 thread_sleep microseconds = do
  23   let seconds = microseconds * (10 ^ (6 :: Int))
  24   threadDelay seconds
  25
  26
  27 message_from_status :: Message -> Status -> Message
  28 message_from_status message status =
  29     message { subject = "Twat: " ++ (screen_name (user status)),
  30               body    = (pretty_print status) }
  31
  32 recurse :: String -> Integer -> (Maybe Message) -> IO ()
  33 recurse username latest_status_id maybe_message = do
  34     thread_sleep heartbeat
  35     xmldata <- get_user_new_statuses username latest_status_id
  36
  37     -- Parsing an empty result can blow up. Just pretend there are
  38     -- no new statuses in that case.
  39     let new_statuses = case xmldata of
  40                          Just xml -> parse_statuses xml
  41                          Nothing  -> []
  42
  43     case (length new_statuses) of
  44       0 ->
  45         recurse username latest_status_id maybe_message
  46       _ -> do
  47         let new_latest_status_id = get_max_status_id new_statuses
  48         mapM (putStrLn . pretty_print) new_statuses
  49
  50         case maybe_message of
  51           Nothing -> do
  52              recurse username new_latest_status_id maybe_message
  53              return ()
  54           Just message -> do
  55              let messages = map (message_from_status message) new_statuses
  56              sendmail_results <- mapM sendmail messages
  57              mapM print_sendmail_result sendmail_results
  58              recurse username new_latest_status_id maybe_message
  59              return ()
  60
  61
  62 get_latest_status_id :: String -> IO Integer
  63 get_latest_status_id username = do
  64   xmldata <- get_user_timeline username
  65
  66   let initial_statuses = case xmldata of
  67                            Just xml -> parse_statuses xml
  68                            Nothing -> []
  69
  70   case (length initial_statuses) of
  71     0 -> do
  72       -- If the HTTP part barfs, try again after a while.
  73       putStrLn ("Couldn't retrieve " ++ username ++ "'s timeline. Retrying...")
  74       thread_sleep heartbeat
  75       get_latest_status_id username
  76     _ -> return (get_max_status_id initial_statuses)
  77
  78
  79
  80 run_twat :: Maybe Message -> String -> IO ()
  81 run_twat message username = do
  82   latest_status_id <- get_latest_status_id username
  83   recurse username latest_status_id message
  84   return ()
  85
  86
  87 main :: IO ()
  88 main = do
  89   errors <- parse_errors
  90
  91   -- If there  were errors parsing the command-line options,
  92   -- print them and exit.
  93   when (not (null errors)) $ do
  94       hPutStrLn stderr (concat errors)
  95       putStrLn help_text
  96       exitWith (ExitFailure exit_args_parse_failed)
  97
  98   -- Next, check to see if the 'help' option was passed to the
  99   -- program. If it was, display the help, and exit successfully.
 100   help_opt_set <- help_set
 101   when help_opt_set $ do
 102       putStrLn help_text
 103       exitWith ExitSuccess
 104
 105   usernames <- parse_usernames
 106
 107   -- If we have both a "To" and "From" address, we'll create a
 108   -- message object to be passed to all of our threads.
 109   to_address <- to_email_address
 110   from_address <- from_email_address
 111   let message = case to_address of
 112                   Nothing -> Nothing
 113                   Just toaddr ->
 114                       case from_address of
 115                         Nothing -> Nothing
 116                         Just fromaddr ->
 117                             Just (Message { headers = [],
 118                                             body = "",
 119                                             subject = "",
 120                                             to = toaddr,
 121                                             from = fromaddr })
 122
 123   -- Execute run_twat on each username in a new thread.
 124   mapM (forkIO . (run_twat message)) usernames
 125
 126   forever $ do
 127     -- This thread (the one executing main) doesn't do anything,
 128     -- but when it terminates, so do all the threads we forked.
 129     -- As a result, we need to keep this thread on life support.
 130     thread_sleep heartbeat
 131
 132   return ()