From: Michael Orlitzky Date: Sun, 11 Dec 2011 16:41:10 +0000 (-0500) Subject: Take the heartbeat (in seconds) from the command line. Default to ten minutes. X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=commitdiff_plain;h=ef7a19a9d1a51bb31e98321fed395c8f41c16c28 Take the heartbeat (in seconds) from the command line. Default to ten minutes. --- diff --git a/src/CommandLine.hs b/src/CommandLine.hs index da6a04b..8d8ceab 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -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] [username2, [username3]...]" +usage = "Usage: twat [-n heartbeat] [-t to_address] [-f from_address] [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) diff --git a/src/Main.hs b/src/Main.hs index fc7966f..3ae09eb 100644 --- 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 ()