1 {-# LANGUAGE NoMonomorphismRestriction #-}
3 -- | Functions and data for working with Twitter statuses.
4 module Twitter.Status (
14 import Control.Applicative ((<$>), (<*>))
15 import Control.Monad (liftM)
16 import Data.Aeson ((.:), FromJSON(..), Value(Object))
17 import Data.Maybe (mapMaybe, isJust)
18 import Data.Monoid (mempty)
19 import Data.String.Utils (join, splitWs)
20 import Data.Text (pack)
21 import Data.Time (formatTime)
22 import Data.Time.Clock (UTCTime)
23 import Data.Time.Format (parseTime)
24 import Data.Time.LocalTime (TimeZone, utcToZonedTime)
25 import System.Locale (defaultTimeLocale, rfc822DateFormat)
26 import Test.Framework (Test, testGroup)
27 import Test.Framework.Providers.HUnit (testCase)
28 import Test.HUnit (Assertion, assertEqual)
29 import Text.Regex (matchRegex, mkRegex)
31 import Html (replace_entities)
32 import StringUtils (listify)
33 import Twitter.User (User(..), screen_name_to_timeline_url)
35 data Status = Status {
36 created_at :: Maybe UTCTime,
44 type Timeline = [Status]
46 instance FromJSON Status where
47 parseJSON (Object t) =
49 liftM parse_status_time (t .: created_at_field) <*>
51 liftM isJustInt (t .: in_reply_to_status_id_field) <*>
52 (t .: retweeted_field) <*>
53 liftM replace_entities (t .: text_field) <*>
56 -- The typechecker flips out without this.
57 isJustInt :: Maybe Int -> Bool
60 created_at_field = pack "created_at"
62 in_reply_to_status_id_field = pack "in_reply_to_status_id"
63 retweeted_field = pack "retweeted"
64 text_field = pack "text"
65 user_field = pack "user"
70 parse_status_time :: String -> Maybe UTCTime
72 parseTime defaultTimeLocale status_format
74 -- | Should match e.g. "Sun Oct 24 18:21:41 +0000 2010"
75 status_format :: String
76 status_format = "%a %b %d %H:%M:%S %z %Y"
78 utc_time_to_rfc822 :: Maybe TimeZone -> UTCTime -> String
79 utc_time_to_rfc822 mtz utc =
82 Just tz -> foo $ utcToZonedTime tz utc
84 foo = formatTime defaultTimeLocale rfc822DateFormat
87 show_created_at :: Maybe TimeZone -> Status -> String
89 (maybe "" (utc_time_to_rfc822 mtz)) . created_at
91 -- | Returns a nicely-formatted String representing the given 'Status'
93 pretty_print :: Maybe TimeZone -> Status -> String
94 pretty_print mtz status =
99 replicate bar_length '-',
103 join "\n" user_timeline_urls,
106 sca = show_created_at mtz status
107 name = screen_name (user status)
108 user_timeline_urls = listify (make_user_timeline_urls status)
109 bar_length = (length name) + 3 + (length sca)
112 -- | Given a list of statuses, returns the greatest status_id
113 -- belonging to one of the statuses in the list.
114 get_max_status_id :: Timeline -> Integer
115 get_max_status_id statuses =
118 status_ids = map status_id statuses
121 -- | Parse one username from a word.
122 parse_username :: String -> Maybe String
123 parse_username word =
127 Just (first_match:_) -> Just first_match
129 username_regex = mkRegex "@([a-zA-Z0-9_]+)"
130 matches = matchRegex username_regex word
133 -- | Parse all usernames of the form \@username from a status.
134 parse_usernames_from_status :: Status -> [String]
135 parse_usernames_from_status status =
136 mapMaybe parse_username status_words
138 status_words = splitWs (text status)
140 -- | Get all referenced users' timeline URLs.
141 make_user_timeline_urls :: Status -> [String]
142 make_user_timeline_urls status =
143 map screen_name_to_timeline_url usernames
145 usernames = parse_usernames_from_status status
150 testGroup "Status Tests" [ tc1 ]
152 tc1 = testCase "All usernames are parsed." test_parse_usernames
155 test_parse_usernames :: Assertion
156 test_parse_usernames =
158 "All usernames are parsed."
162 dummy_user = User { screen_name = "nobody" }
163 dummy_text = "Hypothesis: @donsbot and @bonus500 are two " ++
164 "personalities belonging to the same person."
165 dummy_status = Status { status_id = 1,
166 created_at = Nothing,
173 actual_usernames = parse_usernames_from_status dummy_status
174 expected_usernames = ["donsbot", "bonus500"]