X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=blobdiff_plain;f=src%2FMain.hs;fp=src%2FMain.hs;h=3c33d1d8aadcc0274e933c8ce3d68bca1ee296b0;hp=b7d7f716a32722431b6d27eee617e9aaa69b31a1;hb=1b72ed45ef890ed1329a32457b4d7f3a7fb37788;hpb=0ed071e75268da9ba8273d5c13817fa1297c94e2

diff --git a/src/Main.hs b/src/Main.hs
index b7d7f71..3c33d1d 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -4,20 +4,19 @@ where
 import Control.Concurrent ( forkIO, threadDelay )
 import Control.Monad ( forever, when )
 import Data.Aeson ( decode )
-import Data.List ( (\\) )
 import Data.Maybe ( fromMaybe, isNothing )
 import Data.Monoid ( (<>) )
 import Data.Time.LocalTime ( TimeZone, getCurrentTimeZone )
+import System.Console.CmdArgs.Default ( Default(..) )
 import System.Exit ( ExitCode(..), exitWith )
 import System.IO ( hPutStrLn, stderr )
 
 import CommandLine ( get_args, show_help )
-import Configuration ( Cfg(..), default_config, merge_optional )
+import Configuration ( Cfg(..), merge_optional )
 import ExitCodes ( exit_no_usernames )
 import qualified OptionalConfiguration as OC ( from_rc )
 import Mail (
   Message(..),
-  default_headers,
   print_sendmail_result,
   rfc822_now,
   sendmail )
@@ -33,6 +32,7 @@ import Usernames ( Usernames(..) )
 
 -- | A wrapper around threadDelay which takes seconds instead of
 --   microseconds as its argument.
+--
 thread_sleep :: Int -> IO ()
 thread_sleep seconds = do
   let microseconds = seconds * (10 ^ (6 :: Int))
@@ -40,21 +40,24 @@ thread_sleep seconds = do
 
 
 -- | Given a 'Message', 'Status', and date, update that message's body
--- and subject with the information contained in the status. Adds a
--- /Date: / header, and returns the updated message.
+--   and subject with the information contained in the status. Adds a
+--   /Date: / header, and returns the updated message.
+--
 message_from_status :: Maybe TimeZone -> Message -> String -> Status -> Message
 message_from_status mtz message default_date status =
   message { subject = "Halcyon: " ++ (screen_name (user status)),
             body    = (pretty_print mtz status),
             headers = ((headers message) ++ ["Date: " ++ date])}
   where
-    date =
-      case created_at status of
-        Nothing -> default_date
-        Just c  -> utc_time_to_rfc822 mtz c
+    date = maybe
+             default_date -- default
+             (utc_time_to_rfc822 mtz) -- function to apply if not Nothing
+             (created_at status) -- the Maybe thing
 
--- | If the given Message is not Nothing, send a copy of it for every
--- Status in the list.
+
+-- | If the given 'Message' is not 'Nothing', send a copy of it for
+--   every 'Status' in the @statuses@ list.
+--
 send_messages :: Cfg -> Maybe TimeZone -> Maybe Message -> [Status] -> IO ()
 send_messages cfg mtz maybe_message statuses =
   case maybe_message of
@@ -64,13 +67,14 @@ send_messages cfg mtz maybe_message statuses =
       let mfs = message_from_status mtz message default_date
       let messages = map mfs statuses
       sendmail_results <- mapM sendmail' messages
-      _ <- mapM print_sendmail_result sendmail_results
-      return ()
+      mapM_ print_sendmail_result sendmail_results
   where
     sendmail' = sendmail (sendmail_path cfg)
 
+
 -- | 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
@@ -81,6 +85,7 @@ mention_replies cfg ss = do
 
 -- | 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 retweeted ss
@@ -91,29 +96,27 @@ mention_retweets cfg ss = do
 
 
 -- | Filter out replies/retweets based on the configuration.
+--
 filter_statuses :: Cfg -> [Status] -> [Status]
-filter_statuses cfg ss =
-  good_statuses
+filter_statuses cfg statuses =
+  (reply_filter . retweet_filter) statuses
   where
-  replies  = filter reply ss
-  retweets = filter retweeted ss
-
-  good_statuses' = if (ignore_replies cfg)
-                   then ss \\ replies
-                   else ss
-
-  good_statuses = if (ignore_retweets cfg)
-                  then good_statuses' \\ retweets
-                  else good_statuses'
+    reply_filter = if ignore_replies cfg
+                   then filter (not . reply)
+                   else id
 
+    retweet_filter = if ignore_retweets cfg
+                     then filter (not . retweeted)
+                     else id
 
 
 -- | 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
+--   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)
@@ -155,6 +158,7 @@ recurse cfg username latest_status_id maybe_message = do
 
 -- | 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 :: Cfg -> String -> IO Integer
 get_latest_status_id cfg username = do
   let delay = heartbeat cfg
@@ -185,31 +189,28 @@ get_latest_status_id cfg 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 :: Cfg -> Maybe Message -> String -> IO ()
 run cfg msg username = do
   latest_status_id <- get_latest_status_id 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.
+--   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' for each supplied username. After
--- forking, main loops forever.
+  return $ def { to = to_addr, from = from_addr }
+
+
+-- | The main function just parses the command-line arguments and then
+--   forks off calls to 'run' for each supplied username. After
+--   forking, main loops forever.
+--
 main :: IO ()
 main = do
   -- And a Cfg object.
@@ -222,7 +223,7 @@ main = do
 
   -- Finally, update a default config with any options that have been
   -- set in either the config file or on the command-line.
-  let cfg = merge_optional default_config opt_config
+  let cfg = merge_optional (def :: Cfg) opt_config
 
   when (null $ get_usernames (usernames cfg)) $ do
     hPutStrLn stderr "ERROR: no usernames supplied."