Take the heartbeat (in seconds) from the command line. Default to ten minutes.
authorMichael Orlitzky <michael@orlitzky.com>
Sun, 11 Dec 2011 16:41:10 +0000 (11:41 -0500)
committerMichael Orlitzky <michael@orlitzky.com>
Sun, 11 Dec 2011 16:41:10 +0000 (11:41 -0500)
src/CommandLine.hs
src/Main.hs

index da6a04b06b35e2f2cdf3472bb68d53311611e05c..8d8ceab521037a38dca6e7f19b9c505b0884d61e 100644 (file)
@@ -2,7 +2,8 @@
 -- It should more or less be a black box, providing Main with only the
 -- information it requires.
 module CommandLine
-( help_set,
+( heartbeat,
+  help_set,
   help_text,
   from_email_address,
   to_email_address,
@@ -17,7 +18,8 @@ import System.Environment (getArgs)
 
 
 -- |A record containing values for all available options.
-data Options = Options { opt_help  :: Bool,
+data Options = Options { opt_heartbeat :: Maybe Int,
+                         opt_help  :: Bool,
                          opt_from :: Maybe String,
                          opt_to :: Maybe String }
 
@@ -25,7 +27,8 @@ data Options = Options { opt_help  :: Bool,
 -- |Constructs an instance of Options, with each of its members set to
 -- default values.
 default_options :: Options
-default_options = Options { opt_help = False,
+default_options = Options { opt_heartbeat = Just 600,
+                            opt_help = False,
                             opt_from = Nothing,
                             opt_to = Nothing }
 
@@ -41,11 +44,25 @@ default_options = Options { opt_help = False,
 options :: [OptDescr (Options -> IO Options)]
 options =
   [ Option ['h'][] (NoArg set_help) "Prints this help message.",
+    Option ['n'][] (ReqArg set_heartbeat "heartbeat") "How many seconds to wait between polling.",
     Option ['t'][] (ReqArg set_to "email_address") "Send tweets TO email_address.",
     Option ['f'][] (ReqArg set_from "email_address") "Send tweets FROM email_address."
   ]
 
 
+-- | Attempt to parse an 'Int' from a 'String'. This is just a 'Maybe'
+--   wrapper around 'reads'.
+parse_int :: String -> Maybe Int
+parse_int s =
+  case (reads s) of
+    [(n,_)]   -> Just n
+    _         -> Nothing
+
+set_heartbeat :: String -> Options -> IO Options
+set_heartbeat arg opts = do
+  let new_heartbeat = parse_int arg
+  return opts { opt_heartbeat = new_heartbeat }
+
 set_help :: Options -> IO Options
 set_help opts = do
   return opts { opt_help = True }
@@ -61,7 +78,7 @@ set_from arg opts = do
 
 -- The usage header.
 usage :: String
-usage = "Usage: twat [-t to_address] [-f from_address] <username1> [username2, [username3]...]"
+usage = "Usage: twat [-n heartbeat] [-t to_address] [-f from_address] <username1> [username2, [username3]...]"
 
 
 -- The usage header, and all available flags (as generated by GetOpt)
@@ -84,6 +101,14 @@ parse_options = do
   return opts
 
 
+-- | A list of parse errors relating to the heartbeat.
+heartbeat_errors :: IO [String]
+heartbeat_errors = do
+  hb <- heartbeat
+  if (isNothing hb)
+    then return ["\"heartbeat\" does not appear to be an integer."]
+    else return []
+
 -- |Parse errors relating to the list of usernames.
 username_errors :: IO [String]
 username_errors = do
@@ -91,7 +116,7 @@ username_errors = do
   let (_, usernames, _) = getOpt Permute options argv
 
   if (null usernames)
-    then return ["No usernames provided."]
+    then return ["no usernames provided."]
     else return []
 
 
@@ -101,7 +126,7 @@ to_errors = do
   toaddr <- to_email_address
   fromaddr <- from_email_address
   if (isNothing toaddr) && (isJust fromaddr)
-    then return ["\"From\" address specified without \"To\" address."]
+    then return ["\"from\" address specified without \"to\" address."]
     else return []
 
 
@@ -111,7 +136,7 @@ from_errors = do
   toaddr <- to_email_address
   fromaddr <- from_email_address
   if (isJust toaddr) && (isNothing fromaddr)
-    then return ["\"To\" address specified without \"From\" address."]
+    then return ["\"to\" address specified without \"from\" address."]
     else return []
 
 
@@ -125,10 +150,15 @@ parse_errors :: IO [String]
 parse_errors = do
   argv <- getArgs
   let (_, _, errors) = getOpt Permute options argv
+  errs_heartbeat <- heartbeat_errors
   errs_username <- username_errors
   errs_to <- to_errors
   errs_from <- from_errors
-  return $ map format_error (errors ++ errs_username ++ errs_to ++ errs_from)
+  return $ map format_error (errors ++
+                             errs_heartbeat ++
+                             errs_username ++
+                             errs_to ++
+                             errs_from)
 
 -- |Was the "help" option passed on the command line?
 help_set :: IO Bool
@@ -136,6 +166,11 @@ help_set = do
     opts <- parse_options
     return (opt_help opts)
 
+-- |What's the heartbeat?
+heartbeat :: IO (Maybe Int)
+heartbeat = do
+  opts <- parse_options
+  return (opt_heartbeat opts)
 
 -- |What "To" address was given on the command line?
 to_email_address :: IO (Maybe String)
index fc7966f9f1df518283cae1ce2705b1e1effb058e..3ae09ebe9c9b484653bbf5ec85e71780a903de6c 100644 (file)
@@ -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 ()