Thread the Cfg object through the recursive loop, simplifying things greatly.
authorMichael Orlitzky <michael@orlitzky.com>
Fri, 13 Apr 2012 02:27:58 +0000 (22:27 -0400)
committerMichael Orlitzky <michael@orlitzky.com>
Fri, 13 Apr 2012 02:27:58 +0000 (22:27 -0400)
Minor documentation cleanup.

src/CommandLine.hs
src/Main.hs

index 919a3a2136f11a76a9da1441e36b7497084ad407..3fc8eb39098fba581ac5a5c11ae5f13ca4098682 100644 (file)
@@ -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,
 --
--- <http://www.haskell.org/haskellwiki/High-level_option_handling_with_GetOpt>
+--   <http://www.haskell.org/haskellwiki/High-level_option_handling_with_GetOpt>
 --
 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] <username1> [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 }
index 5cd957bed71c80953d5df44c1af8cb05824d7633..bd749f8ca47115b89e7f57c38301ad3f7f7f11e7 100644 (file)
@@ -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