From 27c6a7e62a428ceb1d2a60d456b075feee196da9 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Mon, 25 Oct 2010 04:08:07 -0400 Subject: [PATCH] Add the ability to twat a single status (as a debugging tool). --- src/Main.hs | 31 +++++++++++++++++++++++++++++++ src/Twitter/Http.hs | 13 +++++++++++++ src/Twitter/Status.hs | 13 +++++++++++++ src/Twitter/Xml.hs | 7 +++++++ 4 files changed, 64 insertions(+) diff --git a/src/Main.hs b/src/Main.hs index f6fd170..fc7966f 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -154,3 +154,34 @@ main = do 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 () diff --git a/src/Twitter/Http.hs b/src/Twitter/Http.hs index d7135ce..bff4288 100644 --- a/src/Twitter/Http.hs +++ b/src/Twitter/Http.hs @@ -17,6 +17,12 @@ user_timeline_url username = "&include_rts=true", "&count=10" ] +status_url :: Integer -> String +status_url status_id = + concat [ "http://api.twitter.com/1/statuses/show/", + (show status_id), + ".xml" ] + -- |Given username's last status id, constructs the API URL for -- username's new statuses. Essentially, 'user_timeline_url' with a -- "since_id" parameter tacked on. @@ -26,6 +32,13 @@ user_new_statuses_url username last_status_id = "&since_id=" ++ (show last_status_id) ] +get_status :: Integer -> IO (Maybe String) +get_status status_id = do + let uri = (status_url status_id) + status <- (http_get uri) + return status + + -- |Return's username's timeline, or 'Nothing' if there was an error. get_user_timeline :: String -> IO (Maybe String) get_user_timeline username = do diff --git a/src/Twitter/Status.hs b/src/Twitter/Status.hs index a2e6255..59b9876 100644 --- a/src/Twitter/Status.hs +++ b/src/Twitter/Status.hs @@ -55,6 +55,19 @@ status_from_content content = first_user = user_from_content (users !! 0) +-- |Takes an XML String as an argument, and returns the +-- status that was parsed from it. Should only be used +-- on XML string where a is a top-level element. +parse_status :: String -> [Status] +parse_status xml_data = + catMaybes maybe_status + where + (Document _ _ root _) = xmlParse xml_file_name xml_data + root_elem = CElem root + status_element = (single_status root_elem) + maybe_status = map status_from_content status_element + + -- |Takes an XML String as an argument, and returns the list of -- statuses that can be parsed from it. parse_statuses :: String -> [Status] diff --git a/src/Twitter/Xml.hs b/src/Twitter/Xml.hs index 8ffd9dd..1b1ea48 100644 --- a/src/Twitter/Xml.hs +++ b/src/Twitter/Xml.hs @@ -15,6 +15,13 @@ get_char_data (CRef ref) = Just (verbatim ref) -- Entities. get_char_data _ = Nothing +-- |A 'CFilter' returning all top-level elements. +-- The name is due to the fact that if we retrieve more than +-- one status, they will be wrapped in a tag, and +-- thus not be top-level. +single_status :: CFilter +single_status = (tag "status") + -- |A 'CFilter' returning all tags within . all_statuses :: CFilter all_statuses = (tag "statuses" /> tag "status") -- 2.44.2