Take the heartbeat (in seconds) from the command line. Default to ten minutes.

[dead/halcyon.git] / src / Main.hs

diff --git a/src/Main.hs b/src/Main.hs
index fc7966f9f1df518283cae1ce2705b1e1effb058e..3ae09ebe9c9b484653bbf5ec85e71780a903de6c 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -3,6 +3,7 @@ where
 
 import Control.Concurrent (forkIO, threadDelay)
 import Control.Monad (forever, when)
+import Data.Maybe (fromJust)
 import System.Exit (ExitCode(..), exitWith)
 import System.IO (hPutStrLn, stderr)
 
@@ -14,10 +15,6 @@ 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 ()
@@ -36,15 +33,16 @@ message_from_status message date 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
+-- |This is the main recursive loop. It takes a length of time to
+-- delay (in seconds), 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 :: Int -> String -> Integer -> (Maybe Message) -> IO ()
+recurse delay username latest_status_id maybe_message = do
+    thread_sleep delay
     xmldata <- get_user_new_statuses username latest_status_id
 
     -- Parsing an empty result can blow up. Just pretend there are
@@ -55,28 +53,28 @@ recurse username latest_status_id maybe_message = do
 
     case (length new_statuses) of
       0 ->
-        recurse username latest_status_id maybe_message
+        recurse delay 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
+             recurse delay 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
+             recurse delay 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
+get_latest_status_id :: Int -> String -> IO Integer
+get_latest_status_id delay username = do
   xmldata <- get_user_timeline username
 
   let initial_statuses = case xmldata of
@@ -87,8 +85,8 @@ get_latest_status_id username = do
     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
+      thread_sleep delay
+      get_latest_status_id delay username
     _ -> return (get_max_status_id initial_statuses)
 
 
@@ -98,10 +96,10 @@ get_latest_status_id username = do
 -- 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
+run_twat :: Int -> Maybe Message -> String -> IO ()
+run_twat delay message username = do
+  latest_status_id <- get_latest_status_id delay username
+  recurse delay username latest_status_id message
   return ()
 
 
@@ -144,14 +142,17 @@ main = do
                                             to = toaddr,
                                             from = fromaddr })
 
+  -- This should be safe since we checked for parse errors earlier.
+  delay <- fmap fromJust heartbeat
+
   -- Execute run_twat on each username in a new thread.
-  _ <- mapM (forkIO . (run_twat message)) usernames
+  _ <- mapM (forkIO . (run_twat delay 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
+    thread_sleep delay
 
   return ()