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