X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=blobdiff_plain;f=src%2FMain.hs;h=fc7966f9f1df518283cae1ce2705b1e1effb058e;hp=de209899bfedfb9611b269e21e8693b00f4aa79b;hb=27c6a7e62a428ceb1d2a60d456b075feee196da9;hpb=376e4ed1f16a0fe5a4d100877c618d85e20a9b8f diff --git a/src/Main.hs b/src/Main.hs index de20989..fc7966f 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -58,7 +58,7 @@ recurse username latest_status_id maybe_message = do recurse username latest_status_id maybe_message _ -> do let new_latest_status_id = get_max_status_id new_statuses - mapM (putStrLn . pretty_print) new_statuses + _ <- mapM (putStrLn . pretty_print) new_statuses case maybe_message of Nothing -> do @@ -68,7 +68,7 @@ recurse username latest_status_id maybe_message = do date_header <- construct_date_header let messages = map (message_from_status message (date_header)) new_statuses sendmail_results <- mapM sendmail messages - mapM print_sendmail_result sendmail_results + _ <- mapM print_sendmail_result sendmail_results recurse username new_latest_status_id maybe_message return () @@ -145,12 +145,43 @@ main = do from = fromaddr }) -- Execute run_twat on each username in a new thread. - mapM (forkIO . (run_twat message)) usernames + _ <- mapM (forkIO . (run_twat message)) usernames - forever $ do + _ <- 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 heartbeat return () + + +-- |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 + + -- Parsing an empty result can blow up. Just pretend there are + -- no new statuses in that case. + let statuses = case xmldata of + Just xml -> parse_status xml + Nothing -> [] + + case (length statuses) of + 0 -> do + putStrLn "No statuses returned." + return () + _ -> do + _ <- mapM (putStrLn . pretty_print) statuses + + case maybe_message of + Nothing -> do + putStrLn "No message object given." + return () + Just message -> do + date_header <- construct_date_header + let messages = map (message_from_status message (date_header)) statuses + sendmail_results <- mapM sendmail messages + _ <- mapM print_sendmail_result sendmail_results + return ()