src/Twitter/Status.hs

   1 -- |Functions and data for working with Twitter statuses.
   2 module Twitter.Status
   3 where
   4
   5 import Data.Maybe
   6 import Data.String.Utils (join, splitWs)
   7 import Test.HUnit
   8 import Text.Regex (matchRegex, mkRegex)
   9 import Text.XML.HaXml
  10 import Text.XML.HaXml.Posn (noPos)
  11
  12 import StringUtils (listify)
  13 import Twitter.User
  14 import Twitter.Xml
  15
  16 -- |Represents one Twitter status. We don't care about any of their
  17 -- other properties.
  18 data Status = Status { status_id  :: Integer,
  19                        created_at :: String,
  20                        text       :: String,
  21                        user       :: User }
  22             deriving (Show, Eq)
  23
  24
  25 -- |Given some XML content, create a 'Status' from it.
  26 status_from_content :: Content i -> (Maybe Status)
  27 status_from_content content =
  28
  29     if (length status_ids) == 0
  30         || (length created_ats) == 0
  31         || (length texts) == 0
  32         || (length users) == 0
  33     then
  34         Nothing
  35     else
  36         case first_status_id of
  37           Nothing -> Nothing
  38           (Just status_id_data) ->
  39               case first_created_at of
  40                   Nothing -> Nothing
  41                   (Just created_at_data) ->
  42                           case first_user of
  43                               Nothing -> Nothing
  44                               (Just user_object) ->
  45                                   case (reads status_id_data :: [(Integer, String)]) of
  46                                     []   -> Nothing
  47                                     parseresult:_ -> Just (Status (fst parseresult) created_at_data all_text user_object)
  48
  49     where
  50       status_ids = (unique_id content)
  51       first_status_id = get_char_data (status_ids !! 0)
  52
  53       created_ats = (status_created_at content)
  54       first_created_at = get_char_data (created_ats !! 0)
  55
  56       texts = (status_text content)
  57       all_text = concat $ catMaybes (map get_char_data texts)
  58
  59       users = (status_user content)
  60       first_user = user_from_content (users !! 0)
  61
  62
  63 -- |Takes an XML String as an argument, and returns the
  64 -- status that was parsed from it. Should only be used
  65 -- on XML string where a <status> is a top-level element.
  66 parse_status :: String -> [Status]
  67 parse_status xml_data =
  68     catMaybes maybe_status
  69     where
  70       (Document _ _ root _) = xmlParse xml_file_name xml_data
  71       root_elem = CElem root noPos
  72       status_element = (single_status root_elem)
  73       maybe_status = map status_from_content status_element
  74
  75
  76 -- |Takes an XML String as an argument, and returns the list of
  77 -- statuses that can be parsed from it.
  78 parse_statuses :: String -> [Status]
  79 parse_statuses xml_data =
  80     catMaybes maybe_statuses
  81     where
  82       (Document _ _ root _) = xmlParse xml_file_name xml_data
  83       root_elem = CElem root noPos
  84       status_elements = (all_statuses root_elem)
  85       maybe_statuses = map status_from_content status_elements
  86
  87
  88 -- |This is a required parameter to the xmlParse function used in
  89 -- error reporting. We're not parsing a function, though, so we leave
  90 -- it blank.
  91 xml_file_name :: String
  92 xml_file_name = ""
  93
  94 -- |Returns a nicely-formatted String representing the given 'Status'
  95 -- object.
  96 pretty_print :: Status -> String
  97 pretty_print status =
  98     concat [ name,
  99              " - ",
 100              (created_at status),
 101              "\n",
 102              replicate ((length name) + 3 + (length (created_at status))) '-',
 103              "\n",
 104              replace_entities (text status),
 105              "\n\n",
 106              join "\n" user_timeline_urls,
 107              "\n" ]
 108              where
 109                name = screen_name (user status)
 110                user_timeline_urls = listify (make_user_timeline_urls status)
 111
 112
 113 -- |Given a list of statuses, returns the greatest status_id belonging
 114 -- to one of the statuses in the list.
 115 get_max_status_id :: [Status] -> Integer
 116 get_max_status_id statuses =
 117   maximum status_ids
 118   where
 119     status_ids = map status_id statuses
 120
 121
 122 -- |Parse one username from a word.
 123 parse_username :: String -> Maybe String
 124 parse_username word =
 125     case matches of
 126       Nothing -> Nothing
 127       Just [] -> Nothing
 128       Just (first_match:_) -> Just first_match
 129     where
 130       username_regex = mkRegex "@([a-zA-Z0-9_]+)"
 131       matches = matchRegex username_regex word
 132
 133
 134 -- |Parse all usernames of the form @username from a status.
 135 parse_usernames_from_status :: Status -> [String]
 136 parse_usernames_from_status status =
 137     catMaybes (map parse_username status_words)
 138     where
 139       status_words = splitWs (text status)
 140
 141 -- |Get all referenced users' timeline URLs.
 142 make_user_timeline_urls :: Status -> [String]
 143 make_user_timeline_urls status =
 144     map screen_name_to_timeline_url usernames
 145     where
 146       usernames = parse_usernames_from_status status
 147
 148
 149 status_tests :: [Test]
 150 status_tests = [ test_parse_usernames ]
 151
 152
 153 test_parse_usernames :: Test
 154 test_parse_usernames =
 155     TestCase $ assertEqual "All usernames are parsed." expected_usernames actual_usernames
 156     where
 157       dummy_user = User { screen_name = "nobody" }
 158       dummy_status = Status { status_id = 1,
 159                               created_at = "never",
 160                               text = "Hypothesis: @donsbot and @bonus500 are two personalities belonging to the same person.",
 161                               user = dummy_user }
 162
 163       actual_usernames = parse_usernames_from_status dummy_status
 164       expected_usernames = ["donsbot", "bonus500"]