From: Michael Orlitzky <michael@orlitzky.com>
Date: Mon, 25 Oct 2010 08:08:07 +0000 (-0400)
Subject: Add the ability to twat a single status (as a debugging tool).
X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=27c6a7e62a428ceb1d2a60d456b075feee196da9;p=dead%2Fhalcyon.git

Add the ability to twat a single status (as a debugging tool).
---

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 <status> 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 <status> elements.
+-- The name is due to the fact that if we retrieve more than
+-- one status, they will be wrapped in a <statuses> tag, and
+-- thus not be top-level.
+single_status :: CFilter
+single_status = (tag "status")
+
 -- |A 'CFilter' returning all <status> tags within <statuses>.
 all_statuses :: CFilter
 all_statuses = (tag "statuses" /> tag "status")