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