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.Tasty ( TestTree, testGroup )
26 import Test.Tasty.HUnit ( (@?=), testCase )
28 import Html ( replace_entities )
29 import StringUtils ( listify )
30 import Twitter.User ( User(..), screen_name_to_timeline_url )
33 -- | Representation of a Twitter user status. We only care about a few
34 -- of the fields, and those are all that we bother to include in the
37 data Status = Status {
38 created_at :: Maybe UTCTime,
46 type Timeline = [Status]
49 instance FromJSON Status where
50 -- | Use a bunch of applicative magic to parse a 'Status' out of the
51 -- JSON that we get from the Twitter API.
53 parseJSON (Object t) =
55 liftM parse_status_time (t .: created_at_field) <*>
57 liftM isJustInt (t .: in_reply_to_status_id_field) <*>
58 (t .: retweeted_field) <*>
59 liftM replace_entities (t .: text_field) <*>
62 -- | The typechecker flips out without this; it's just a copy if
63 -- 'isJust' specialized to the 'Int' type.
65 isJustInt :: Maybe Int -> Bool
68 created_at_field = pack "created_at"
70 in_reply_to_status_id_field = pack "in_reply_to_status_id"
71 retweeted_field = pack "retweeted"
72 text_field = pack "text"
73 user_field = pack "user"
79 -- | Parse a timestamp from a status into a UTCTime (or Nothing).
83 -- >>> let s = "Sun Oct 24 18:21:41 +0000 2010"
84 -- >>> parse_status_time s
85 -- Just 2010-10-24 18:21:41 UTC
87 -- >>> parse_status_time "what's up dawg"
90 parse_status_time :: String -> Maybe UTCTime
92 parseTime defaultTimeLocale status_format
94 status_format :: String
95 status_format = "%a %b %d %H:%M:%S %z %Y"
98 -- | Given a 'TimeZone', convert a 'UTCTime' into an RFC822-format
99 -- time string. If no 'TimeZone' is given, assume UTC.
103 -- >>> let s = "Sun Oct 24 18:21:41 +0000 2010"
104 -- >>> let Just t = parse_status_time s
105 -- >>> utc_time_to_rfc822 Nothing t
106 -- "Sun, 24 Oct 2010 18:21:41 UTC"
108 utc_time_to_rfc822 :: Maybe TimeZone -> UTCTime -> String
109 utc_time_to_rfc822 mtz utc =
112 Just tz -> foo $ utcToZonedTime tz utc
114 foo = formatTime defaultTimeLocale rfc822DateFormat
117 -- | Get the 'created_at' time out of a 'Status' and display it as an
118 -- RFC822-format time string. If there's no created-at time in the
119 -- status, you'll get an empty string instead.
121 -- >>> let u = User "washington_irving"
122 -- >>> let created = parse_status_time "Sun Oct 24 18:21:41 +0000 2010"
123 -- >>> let s = Status created 8675309 False False "IM TWITTERING" u
124 -- >>> show_created_at Nothing s
125 -- "Sun, 24 Oct 2010 18:21:41 UTC"
126 -- >>> show_created_at Nothing s{ created_at = Nothing }
129 show_created_at :: Maybe TimeZone -> Status -> String
130 show_created_at mtz =
131 (maybe "" (utc_time_to_rfc822 mtz)) . created_at
134 -- | Returns a nicely-formatted String representing the given 'Status'
139 -- >>> let u = User "washington_irving"
140 -- >>> let created = parse_status_time "Sun Oct 24 18:21:41 +0000 2010"
141 -- >>> let s = Status created 8675309 False False "IM TWITTERING" u
142 -- >>> putStr $ pretty_print Nothing s
143 -- washington_irving - Sun, 24 Oct 2010 18:21:41 UTC
144 -- -------------------------------------------------
149 pretty_print :: Maybe TimeZone -> Status -> String
150 pretty_print mtz status =
155 replicate bar_length '-',
159 join "\n" user_timeline_urls,
162 sca = show_created_at mtz status
163 name = screen_name (user status)
164 user_timeline_urls = listify (make_user_timeline_urls status)
165 bar_length = (length name) + 3 + (length sca)
168 -- | Given a list of statuses, returns the greatest status_id
169 -- belonging to one of the statuses in the list.
173 -- >>> let u = User "washington_irving"
174 -- >>> let created = parse_status_time "Sun Oct 24 18:21:41 +0000 2010"
175 -- >>> let s = Status created 8675309 False False "IM TWITTERING" u
176 -- >>> let timeline = [s,s,s,s,s]
177 -- >>> get_max_status_id timeline
180 get_max_status_id :: Timeline -> Integer
181 get_max_status_id statuses =
184 status_ids = map status_id statuses
187 -- | Parse one username from a 'String'.
191 -- >>> parse_username "@washington_irving"
192 -- Just "washington_irving"
193 -- >>> parse_username "washington_irving"
195 -- >>> parse_username "Everbody loves @washington_irving, even Raymond"
196 -- Just "washington_irving"
198 -- >>> parse_username "herp @@@ derp @washington_irving foo@@BAR"
199 -- Just "washington_irving"
201 -- >>> parse_username "tailing at sign y'all @"
204 parse_username :: String -> Maybe String
206 | null parse_result = Nothing
207 | otherwise = Just parse_result
209 -- | A list of characters valid in a Twitter username.
211 username_chars :: String
212 username_chars = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "_"
214 -- | Take a string and drop everything (including the \'@\') up to
215 -- the first character of the first username (if one exists).
217 start_name :: String -> String
219 case dropWhile (/= '@') w of
223 parse_userchars :: String -> String
224 parse_userchars = takeWhile (`elem` username_chars)
226 -- | Parse a username from the given String by dropping all
227 -- characters that don't belong to it. This function calls
228 -- itself recursively until it gets a username or runs out of
231 parse_name :: String -> String
233 parse_name rest@(_:xs) =
234 let ucs = (parse_userchars . start_name) rest in
239 parse_result :: String
240 parse_result = parse_name s
243 -- | Parse all usernames of the form \@username from a status.
247 -- >>> let u = User "washington_irving"
248 -- >>> let b = "YO WHERE'S @BONUS500 and @@@ I LOVE @AT SIGNS@"
249 -- >>> let s = Status Nothing 8675309 False False b u
250 -- >>> parse_usernames_from_status s
253 parse_usernames_from_status :: Status -> [String]
254 parse_usernames_from_status status =
255 mapMaybe parse_username status_words
257 status_words = splitWs (text status)
260 -- | Get all referenced users' timeline URLs.
262 make_user_timeline_urls :: Status -> [String]
263 make_user_timeline_urls status =
264 map screen_name_to_timeline_url usernames
266 usernames = parse_usernames_from_status status
269 status_tests :: TestTree
271 testGroup "Status Tests" [ test_parse_usernames ]
274 test_parse_usernames :: TestTree
275 test_parse_usernames =
276 testCase description $ actual @?= expected
278 description = "all usernames are parsed"
280 dummy_user = User { screen_name = "nobody" }
281 dummy_text = "Hypothesis: @donsbot and @bonus500 are two " ++
282 "personalities belonging to the same person."
283 dummy_status = Status { status_id = 1,
284 created_at = Nothing,
291 actual = parse_usernames_from_status dummy_status
292 expected = ["donsbot", "bonus500"]