X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=blobdiff_plain;f=src%2FMain.hs;h=b7d7f716a32722431b6d27eee617e9aaa69b31a1;hp=c104874c9c7b026d45d0de5f71c817385eb145c8;hb=d7c6b5499c0969b6e488d9fc583f93bbb4e3d4c7;hpb=f519b55ffe72acd791bdc91b16918603afce1995 diff --git a/src/Main.hs b/src/Main.hs index c104874..b7d7f71 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,30 +1,35 @@ module Main where -import Control.Concurrent (forkIO, threadDelay) -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(..), exitWith) -import System.IO (hPutStrLn, stderr) - -import CommandLine -import Configuration (Cfg(..), default_config, merge_optional) -import ExitCodes (exit_no_usernames) -import qualified OptionalConfiguration as OC +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.Exit ( ExitCode(..), exitWith ) +import System.IO ( hPutStrLn, stderr ) + +import CommandLine ( get_args, show_help ) +import Configuration ( Cfg(..), default_config, 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 - ) -import Twitter.Http -import Twitter.Status -import Twitter.User -import Usernames (Usernames(..)) + sendmail ) +import Twitter.Http ( get_user_new_statuses, get_user_timeline ) +import Twitter.Status ( + Status(..), + Timeline, + get_max_status_id, + pretty_print, + utc_time_to_rfc822 ) +import Twitter.User ( User(..) ) +import Usernames ( Usernames(..) ) -- | A wrapper around threadDelay which takes seconds instead of -- microseconds as its argument. @@ -114,14 +119,19 @@ recurse cfg username latest_status_id maybe_message = do thread_sleep (heartbeat cfg) timeline <- get_user_new_statuses cfg username latest_status_id - -- FIXME - let Just new_statuses = decode timeline :: Maybe Timeline + let decoded_timeline = decode timeline :: Maybe Timeline - case (length new_statuses) of - 0 -> - do_recurse latest_status_id - _ -> do + when (isNothing decoded_timeline) $ + hPutStrLn stderr $ + "Couldn't retrieve " + ++ username + ++ "'s timeline. Skipping..." + let new_statuses = fromMaybe [] decoded_timeline + + case new_statuses of + [] -> do_recurse latest_status_id + _ -> do mention_replies cfg new_statuses mention_retweets cfg new_statuses @@ -129,7 +139,7 @@ recurse cfg username latest_status_id maybe_message = do tz <- getCurrentTimeZone let mtz = Just tz - mapM_ (putStrLn . (pretty_print mtz)) good_statuses + mapM_ (putStr . (pretty_print mtz)) good_statuses send_messages cfg mtz maybe_message good_statuses @@ -149,15 +159,24 @@ get_latest_status_id :: Cfg -> String -> IO Integer get_latest_status_id cfg username = do let delay = heartbeat cfg timeline <- get_user_timeline cfg username - let Just initial_timeline = decode timeline :: Maybe Timeline - case (length initial_timeline) of - 0 -> do + let decoded_timeline = decode timeline :: Maybe Timeline + + when (isNothing decoded_timeline) $ + hPutStrLn stderr $ + "Couldn't retrieve " + ++ username + ++ "'s timeline. Skipping..." + + let initial_timeline = fromMaybe [] decoded_timeline + + case initial_timeline of + [] -> do -- If the HTTP part barfs, try again after a while. - putStrLn ("Couldn't retrieve " ++ username ++ "'s timeline. Retrying...") thread_sleep delay get_latest_status_id cfg username - _ -> return (get_max_status_id initial_timeline) + _ -> + return (get_max_status_id initial_timeline) @@ -195,7 +214,7 @@ main :: IO () main = do -- And a Cfg object. rc_cfg <- OC.from_rc - cmd_cfg <- apply_args + cmd_cfg <- get_args -- Merge the config file options with the command-line ones, -- prefering the command-line ones.