From: Michael Orlitzky Date: Fri, 13 Apr 2012 02:27:58 +0000 (-0400) Subject: Thread the Cfg object through the recursive loop, simplifying things greatly. X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=86efdb6afac4a7a165babba90a0a25e0e1185e5b;p=dead%2Fhalcyon.git Thread the Cfg object through the recursive loop, simplifying things greatly. Minor documentation cleanup. --- diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 919a3a2..3fc8eb3 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -1,51 +1,49 @@ --- |The CommandLine module handles parsing of the command-line options. --- It should more or less be a black box, providing Main with only the --- information it requires. +-- | The CommandLine module handles parsing of the command-line +-- options. It should more or less be a black box, providing Main +-- with only the information it requires. module CommandLine -( heartbeat, +( get_cfg, help_set, help_text, - ignore_replies_set, - ignore_retweets_set, - from_email_address, - to_email_address, parse_errors, parse_usernames ) where -import Data.Maybe (isJust, isNothing) +import Data.Maybe (fromJust, isJust, isNothing) import System.Console.GetOpt import System.Environment (getArgs) +import Configuration (Cfg(..)) - --- |A record containing values for all available options. +-- | A record containing values for all available options. data Options = Options { opt_heartbeat :: Maybe Int, opt_help :: Bool, opt_ignore_replies :: Bool, opt_ignore_retweets :: Bool, opt_from :: Maybe String, - opt_to :: Maybe String } + opt_to :: Maybe String, + opt_verbose :: Bool } --- |Constructs an instance of Options, with each of its members set to --- default values. +-- | Constructs an instance of Options, with each of its members set +-- to default values. default_options :: Options default_options = Options { opt_heartbeat = Just 600, opt_help = False, opt_ignore_replies = False, opt_ignore_retweets = False, opt_from = Nothing, - opt_to = Nothing } + opt_to = Nothing, + opt_verbose = False } --- |The options list that we construct associates a function with each --- option. This function is responsible for updating an Options record --- with the appropriate value. +-- | The options list that we construct associates a function with +-- each option. This function is responsible for updating an Options +-- record with the appropriate value. -- --- For more information and an example of this idiom, see, +-- For more information and an example of this idiom, see, -- --- +-- -- options :: [OptDescr (Options -> IO Options)] options = @@ -77,7 +75,12 @@ options = Option ['I']["ignore-retweets"] (NoArg set_ignore_retweets) - "Ignore retweets." + "Ignore retweets.", + + Option + ['v']["verbose"] + (NoArg set_verbose) + "Be verbose about stuff." ] @@ -106,6 +109,10 @@ set_ignore_replies :: Options -> IO Options set_ignore_replies opts = return opts { opt_ignore_replies = True } +set_verbose :: Options -> IO Options +set_verbose opts = + return opts { opt_verbose = True } + set_to :: String -> Options -> IO Options set_to arg opts = do return opts { opt_to = Just arg } @@ -115,17 +122,23 @@ set_from arg opts = do return opts { opt_from = Just arg } --- The usage header. +-- | The usage header. usage :: String usage = "Usage: twat [-n heartbeat] [-t to_address] [-f from_address] [username2, [username3]...]" --- The usage header, and all available flags (as generated by GetOpt) +-- | Was the help option passed? +help_set :: IO Bool +help_set = do + opts <- parse_options + return (opt_help opts) + +-- | The usage header, and all available flags (as generated by GetOpt) help_text :: String help_text = usageInfo usage options --- Return a list of options. +-- | Return a list of options. parse_options :: IO Options parse_options = do argv <- getArgs @@ -143,7 +156,7 @@ parse_options = do -- | A list of parse errors relating to the heartbeat. heartbeat_errors :: IO [String] heartbeat_errors = do - hb <- heartbeat + hb <- parse_heartbeat if (isNothing hb) then return ["\"heartbeat\" does not appear to be an integer."] else return [] @@ -162,29 +175,29 @@ username_errors = do -- |Parse errors relating to the "To" address. to_errors :: IO [String] to_errors = do - toaddr <- to_email_address - fromaddr <- from_email_address + toaddr <- parse_to_address + fromaddr <- parse_from_address if (isNothing toaddr) && (isJust fromaddr) then return ["\"from\" address specified without \"to\" address."] else return [] --- |Parse errors relating to the "From" address. +-- | Parse errors relating to the "From" address. from_errors :: IO [String] from_errors = do - toaddr <- to_email_address - fromaddr <- from_email_address + toaddr <- parse_to_address + fromaddr <- parse_from_address if (isJust toaddr) && (isNothing fromaddr) then return ["\"to\" address specified without \"from\" address."] else return [] --- |Format an error message for printing. +-- | Format an error message for printing. format_error :: String -> String format_error err = "ERROR: " ++ err ++ "\n" --- |Return a list of all parse errors. +-- | Return a list of all parse errors. parse_errors :: IO [String] parse_errors = do argv <- getArgs @@ -199,46 +212,42 @@ parse_errors = do errs_to ++ errs_from) --- |Was the "help" option passed on the command line? -help_set :: IO Bool -help_set = do - opts <- parse_options - return (opt_help opts) - --- | Was the "ignore-replies" option passes on the command line? -ignore_replies_set :: IO Bool -ignore_replies_set = do +-- | What's the heartbeat? +parse_heartbeat :: IO (Maybe Int) +parse_heartbeat = do opts <- parse_options - return (opt_ignore_replies opts) + return (opt_heartbeat opts) --- | Was the "ignore-retweets" option passes on the command line? -ignore_retweets_set :: IO Bool -ignore_retweets_set = do +-- | What "To" address was given on the command line? +parse_to_address :: IO (Maybe String) +parse_to_address = do opts <- parse_options - return (opt_ignore_retweets opts) + return (opt_to opts) --- |What's the heartbeat? -heartbeat :: IO (Maybe Int) -heartbeat = do +-- | What "From" address was given on the command line? +parse_from_address :: IO (Maybe String) +parse_from_address = do opts <- parse_options - return (opt_heartbeat opts) - --- |What "To" address was given on the command line? -to_email_address :: IO (Maybe String) -to_email_address = do - opts <- parse_options - return (opt_to opts) - --- |What "From" address was given on the command line? -from_email_address :: IO (Maybe String) -from_email_address = do - opts <- parse_options - return (opt_from opts) + return (opt_from opts) --- |What usernames were passed on the command line? +-- | What usernames were passed on the command line? parse_usernames :: IO [String] parse_usernames = do argv <- getArgs let (_, usernames, _) = getOpt Permute options argv return usernames + + + +-- | Construct a Cfg object from the command line options assuming +-- there are no errors. +get_cfg :: IO Cfg +get_cfg = do + opts <- parse_options + return Cfg { heartbeat = fromJust $ opt_heartbeat opts, + ignore_replies = opt_ignore_replies opts, + ignore_retweets = opt_ignore_retweets opts, + from_address = opt_from opts, + to_address = opt_to opts, + verbose = opt_verbose opts } diff --git a/src/Main.hs b/src/Main.hs index 5cd957b..bd749f8 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -3,11 +3,12 @@ where import Control.Concurrent (forkIO, threadDelay) import Control.Monad (forever, when) -import Data.Maybe (fromJust) +import Data.List ((\\)) import System.Exit (ExitCode(..), exitWith) import System.IO (hPutStrLn, stderr) import CommandLine +import Configuration (Cfg(..)) import ExitCodes import Mail import Twitter.Http @@ -38,46 +39,104 @@ message_from_status message default_date status = Nothing -> default_date Just c -> c --- |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 +-- | If the given Message is not Nothing, send a copy of it for every +-- Status in the list. +send_messages :: Maybe Message -> [Status] -> IO () +send_messages maybe_message statuses = + case maybe_message of + Nothing -> return () + Just message -> do + default_date <- rfc822_now + let mfs = message_from_status message (default_date) + let messages = map mfs statuses + sendmail_results <- mapM sendmail messages + _ <- mapM print_sendmail_result sendmail_results + return () + + + +-- | Display the number of skipped replies if ignore_replies is true +-- and verbose is enabled. +mention_replies :: Cfg -> [Status] -> IO () +mention_replies cfg ss = do + let replies = filter reply ss + when ((ignore_replies cfg) && (verbose cfg)) $ do + let countstr = show $ length replies + putStrLn $ "Ignoring " ++ countstr ++ " replies." + + +-- | Display the number of skipped retweets if ignore_retweets is true +-- and verbose is enabled. +mention_retweets :: Cfg -> [Status] -> IO () +mention_retweets cfg ss = do + let retweets = filter retweet ss + when ((ignore_retweets cfg) && (verbose cfg)) $ do + let countstr = show $ length retweets + putStrLn $ "Ignoring " ++ countstr ++ " retweets." + + + +-- | Filter out replies/retweets based on the configuration. +filter_statuses :: Cfg -> [Status] -> [Status] +filter_statuses cfg ss = + good_statuses + where + replies = filter reply ss + retweets = filter retweet ss - -- Parsing an empty result can blow up. Just pretend there are - -- no new statuses in that case. - let new_statuses = case xmldata of - Just xml -> parse_statuses xml - Nothing -> [] + good_statuses' = case (ignore_replies cfg) of + True -> ss \\ replies + False -> ss - case (length new_statuses) of - 0 -> - 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 + good_statuses = case (ignore_retweets cfg) of + True -> good_statuses' \\ retweets + False -> good_statuses' - case maybe_message of - Nothing -> do - recurse delay username new_latest_status_id maybe_message - return () - Just message -> do - default_date <- rfc822_now - let messages = map (message_from_status message (default_date)) new_statuses - sendmail_results <- mapM sendmail messages - _ <- mapM print_sendmail_result sendmail_results - 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. +-- | This is the main recursive loop. It takes a the configuration, 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 :: Cfg -> String -> Integer -> (Maybe Message) -> IO () +recurse cfg username latest_status_id maybe_message = do + thread_sleep (heartbeat cfg) + xmldata <- get_user_new_statuses username latest_status_id + + -- Parsing an empty result can blow up. Just pretend there are + -- no new statuses in that case. + let new_statuses = case xmldata of + Just xml -> parse_statuses xml + Nothing -> [] + + case (length new_statuses) of + 0 -> + do_recurse latest_status_id + _ -> do + + mention_replies cfg new_statuses + mention_retweets cfg new_statuses + + let good_statuses = filter_statuses cfg new_statuses + + _ <- mapM (putStrLn . pretty_print) good_statuses + + send_messages maybe_message good_statuses + + let new_latest_status_id = get_max_status_id new_statuses + do_recurse new_latest_status_id + + where + -- This lets us write all of these parameters once rather + -- than... more than once. + do_recurse :: Integer -> IO () + do_recurse lsi = recurse cfg username lsi maybe_message + + +-- | 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 :: Int -> String -> IO Integer get_latest_status_id delay username = do xmldata <- get_user_timeline username @@ -96,18 +155,33 @@ get_latest_status_id delay username = do --- |This function wraps two steps. First, we need to find the latest --- status id posted by username. Once we have that, we can begin the --- 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 :: 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 +-- | This function wraps two steps. First, we need to find the latest +-- status id posted by username. Once we have that, we can begin the +-- 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 :: Cfg -> Maybe Message -> String -> IO () +run_twat cfg msg username = do + latest_status_id <- get_latest_status_id (heartbeat cfg) username + recurse cfg username latest_status_id msg return () + +-- | Take advantage of the Maybe monad to only return a message when +-- we have both a "to" and "from" address. +construct_message :: Cfg -> Maybe Message +construct_message cfg = do + to_addr <- to_address cfg + from_addr <- from_address cfg + return $ make_msg to_addr from_addr + where + make_msg t f = Message { headers = default_headers, + body = "", + subject = "", + to = t, + from = f } + -- |The main function just parses the command-line arguments and then -- forks off calls to 'run_twat' for each supplied username. After -- forking, main loops forever. @@ -124,46 +198,36 @@ main = do -- Next, check to see if the 'help' option was passed to the -- program. If it was, display the help, and exit successfully. - help_opt_set <- help_set - when help_opt_set $ do - putStrLn help_text - exitWith ExitSuccess + help <- help_set + when (help) $ do + putStrLn help_text + exitWith ExitSuccess + -- Get the list of usernames. usernames <- parse_usernames + -- And a Cfg object. + cfg <- get_cfg + -- If we have both a "To" and "From" address, we'll create a -- message object to be passed to all of our threads. - to_address <- to_email_address - from_address <- from_email_address - let message = case to_address of - Nothing -> Nothing - Just toaddr -> - case from_address of - Nothing -> Nothing - Just fromaddr -> - Just (Message { headers = default_headers, - body = "", - subject = "", - to = toaddr, - from = fromaddr }) - - -- This should be safe since we checked for parse errors earlier. - delay <- fmap fromJust heartbeat + let message = construct_message cfg -- Execute run_twat on each username in a new thread. - _ <- mapM (forkIO . (run_twat delay message)) usernames + let run_twat_curried = run_twat cfg message + _ <- mapM (forkIO . run_twat_curried) 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 delay + thread_sleep (heartbeat cfg) return () --- |A debugging tool that will parse, print, and email a single status --- (given by its id). +-- | A debugging tool that will parse, print, and email a single +-- status (given by its id). twat_single_status :: Integer -> (Maybe Message) -> IO () twat_single_status the_status_id maybe_message = do xmldata <- get_status the_status_id