1 {-# LANGUAGE NoMonomorphismRestriction #-}
3 -- | Functions and data for working with Twitter statuses.
4 module Twitter.Status (
13 import Control.Applicative ((<$>), (<*>))
14 import Control.Monad (liftM)
15 import Data.Aeson ((.:), FromJSON(..), Value(Object))
16 import Data.Maybe (mapMaybe, isJust)
17 import Data.Monoid (mempty)
18 import Data.String.Utils (join, splitWs)
19 import Data.Text (pack)
20 import Data.Time (formatTime)
21 import Data.Time.Clock (UTCTime)
22 import Data.Time.Format (parseTime)
23 import Data.Time.LocalTime (TimeZone, utcToZonedTime)
24 import System.Locale (defaultTimeLocale, rfc822DateFormat)
25 import Test.Framework (Test, testGroup)
26 import Test.Framework.Providers.HUnit (testCase)
27 import Test.HUnit (Assertion, assertEqual)
28 import Text.Regex (matchRegex, mkRegex)
30 import Html (replace_entities)
31 import StringUtils (listify)
32 import Twitter.User (User(..), screen_name_to_timeline_url)
34 data Status = Status {
35 created_at :: Maybe UTCTime,
43 type Timeline = [Status]
45 instance FromJSON Status where
46 parseJSON (Object t) =
48 liftM parse_status_time (t .: created_at_field) <*>
50 liftM isJustInt (t .: in_reply_to_status_id_field) <*>
51 (t .: retweeted_field) <*>
52 liftM replace_entities (t .: text_field) <*>
55 -- The typechecker flips out without this.
56 isJustInt :: Maybe Int -> Bool
59 created_at_field = pack "created_at"
61 in_reply_to_status_id_field = pack "in_reply_to_status_id"
62 retweeted_field = pack "retweeted"
63 text_field = pack "text"
64 user_field = pack "user"
69 parse_status_time :: String -> Maybe UTCTime
71 parseTime defaultTimeLocale status_format
73 -- | Should match e.g. "Sun Oct 24 18:21:41 +0000 2010"
74 status_format :: String
75 status_format = "%a %b %d %H:%M:%S %z %Y"
77 utc_time_to_rfc822 :: Maybe TimeZone -> UTCTime -> String
78 utc_time_to_rfc822 mtz utc =
81 Just tz -> foo $ utcToZonedTime tz utc
83 foo = formatTime defaultTimeLocale rfc822DateFormat
86 show_created_at :: Maybe TimeZone -> Status -> String
88 (maybe "" (utc_time_to_rfc822 mtz)) . created_at
90 -- | Returns a nicely-formatted String representing the given 'Status'
92 pretty_print :: Maybe TimeZone -> Status -> String
93 pretty_print mtz status =
98 replicate bar_length '-',
102 join "\n" user_timeline_urls,
105 sca = show_created_at mtz status
106 name = screen_name (user status)
107 user_timeline_urls = listify (make_user_timeline_urls status)
108 bar_length = (length name) + 3 + (length sca)
111 -- | Given a list of statuses, returns the greatest status_id
112 -- belonging to one of the statuses in the list.
113 get_max_status_id :: Timeline -> Integer
114 get_max_status_id statuses =
117 status_ids = map status_id statuses
120 -- | Parse one username from a word.
121 parse_username :: String -> Maybe String
122 parse_username word =
126 Just (first_match:_) -> Just first_match
128 username_regex = mkRegex "@([a-zA-Z0-9_]+)"
129 matches = matchRegex username_regex word
132 -- | Parse all usernames of the form \@username from a status.
133 parse_usernames_from_status :: Status -> [String]
134 parse_usernames_from_status status =
135 mapMaybe parse_username status_words
137 status_words = splitWs (text status)
139 -- | Get all referenced users' timeline URLs.
140 make_user_timeline_urls :: Status -> [String]
141 make_user_timeline_urls status =
142 map screen_name_to_timeline_url usernames
144 usernames = parse_usernames_from_status status
149 testGroup "Status Tests" [ tc1 ]
151 tc1 = testCase "All usernames are parsed." test_parse_usernames
154 test_parse_usernames :: Assertion
155 test_parse_usernames =
157 "All usernames are parsed."
161 dummy_user = User { screen_name = "nobody" }
162 dummy_text = "Hypothesis: @donsbot and @bonus500 are two " ++
163 "personalities belonging to the same person."
164 dummy_status = Status { status_id = 1,
165 created_at = Nothing,
172 actual_usernames = parse_usernames_from_status dummy_status
173 expected_usernames = ["donsbot", "bonus500"]