X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FMain.hs;h=c104874c9c7b026d45d0de5f71c817385eb145c8;hb=f519b55ffe72acd791bdc91b16918603afce1995;hp=14539c11a737defc430d35e8aed0491c9d3cb397;hpb=dd6cea3dc5e830691b1da442fcf91602e4cf94aa;p=dead%2Fhalcyon.git diff --git a/src/Main.hs b/src/Main.hs index 14539c1..c104874 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,21 +2,29 @@ module Main where import Control.Concurrent (forkIO, threadDelay) -import Control.Monad (forever, unless, when) +import Control.Monad (forever, when) import Data.Aeson (decode) import Data.List ((\\)) +import Data.Monoid ((<>)) import Data.Time.LocalTime (TimeZone, getCurrentTimeZone) -import System.Exit (ExitCode(..), exitSuccess, exitWith) +import System.Exit (ExitCode(..), exitWith) import System.IO (hPutStrLn, stderr) import CommandLine -import Configuration (Cfg(..)) -import ExitCodes -import Mail +import Configuration (Cfg(..), default_config, merge_optional) +import ExitCodes (exit_no_usernames) +import qualified OptionalConfiguration as OC +import Mail ( + Message(..), + default_headers, + print_sendmail_result, + rfc822_now, + sendmail + ) import Twitter.Http import Twitter.Status import Twitter.User - +import Usernames (Usernames(..)) -- | A wrapper around threadDelay which takes seconds instead of -- microseconds as its argument. @@ -31,7 +39,7 @@ thread_sleep seconds = do -- /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 = "Twat: " ++ (screen_name (user status)), + message { subject = "Halcyon: " ++ (screen_name (user status)), body = (pretty_print mtz status), headers = ((headers message) ++ ["Date: " ++ date])} where @@ -158,8 +166,8 @@ 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_twat :: Cfg -> Maybe Message -> String -> IO () -run_twat cfg msg username = do +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 () @@ -181,39 +189,34 @@ construct_message cfg = do from = f } -- |The main function just parses the command-line arguments and then --- forks off calls to 'run_twat' for each supplied username. After +-- forks off calls to 'run' for each supplied username. After -- forking, main loops forever. main :: IO () main = do - errors <- parse_errors - - -- If there were errors parsing the command-line options, - -- print them and exit. - unless (null errors) $ do - hPutStrLn stderr (concat errors) - putStrLn help_text - exitWith (ExitFailure exit_args_parse_failed) + -- And a Cfg object. + rc_cfg <- OC.from_rc + cmd_cfg <- apply_args - -- Next, check to see if the 'help' option was passed to the - -- program. If it was, display the help, and exit successfully. - help <- help_set - when (help) $ do - putStrLn help_text - exitSuccess + -- Merge the config file options with the command-line ones, + -- prefering the command-line ones. + let opt_config = rc_cfg <> cmd_cfg - -- Get the list of usernames. - usernames <- parse_usernames + -- 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 - -- And a Cfg object. - cfg <- get_cfg + when (null $ get_usernames (usernames cfg)) $ do + hPutStrLn stderr "ERROR: no usernames supplied." + _ <- show_help + exitWith (ExitFailure exit_no_usernames) -- If we have both a "To" and "From" address, we'll create a -- message object to be passed to all of our threads. let message = construct_message cfg - -- Execute run_twat on each username in a new thread. - let run_twat_curried = run_twat cfg message - _ <- mapM (forkIO . run_twat_curried) usernames + -- Execute run on each username in a new thread. + let run_curried = run cfg message + _ <- mapM (forkIO . run_curried) (get_usernames (usernames cfg)) _ <- forever $ -- This thread (the one executing main) doesn't do anything,