1 {-# LANGUAGE NoMonomorphismRestriction #-}
3 -- | Functions and data for working with Twitter statuses.
7 import Control.Applicative ((<$>), (<*>))
8 import Control.Monad (liftM)
9 import Data.Aeson ((.:), FromJSON(..), Value(Object))
10 import Data.Maybe (fromMaybe, mapMaybe, isJust)
11 import Data.Monoid (mempty)
12 import Data.String.Utils (join, splitWs)
13 import Data.Text (pack)
14 import Data.Time (formatTime)
15 import Data.Time.Clock (UTCTime)
16 import Data.Time.Format (parseTime)
17 import Data.Time.LocalTime (TimeZone, utcToZonedTime)
18 import System.Locale (defaultTimeLocale, rfc822DateFormat)
20 import Text.Regex (matchRegex, mkRegex)
22 import Html (replace_entities)
23 import StringUtils (listify)
26 data Status = Status {
27 created_at :: Maybe UTCTime,
35 type Timeline = [Status]
37 instance FromJSON Status where
38 parseJSON (Object t) =
40 liftM parse_status_time (t .: created_at_field) <*>
42 liftM isJustInt (t .: in_reply_to_status_id_field) <*>
43 (t .: retweeted_field) <*>
44 liftM replace_entities (t .: text_field) <*>
47 -- The typechecker flips out without this.
48 isJustInt :: Maybe Int -> Bool
51 created_at_field = pack "created_at"
53 in_reply_to_status_id_field = pack "in_reply_to_status_id"
54 retweeted_field = pack "retweeted"
55 text_field = pack "text"
56 user_field = pack "user"
61 parse_status_time :: String -> Maybe UTCTime
63 parseTime defaultTimeLocale status_format
65 -- | Should match e.g. "Sun Oct 24 18:21:41 +0000 2010"
66 status_format :: String
67 status_format = "%a %b %d %H:%M:%S %z %Y"
69 utc_time_to_rfc822 :: Maybe TimeZone -> UTCTime -> String
70 utc_time_to_rfc822 mtz utc =
73 Just tz -> foo $ utcToZonedTime tz utc
75 foo = formatTime defaultTimeLocale rfc822DateFormat
78 show_created_at :: Maybe TimeZone -> Status -> String
80 (fromMaybe "") . (fmap $ utc_time_to_rfc822 mtz) . created_at
82 -- | Returns a nicely-formatted String representing the given 'Status'
84 pretty_print :: Maybe TimeZone -> Status -> String
85 pretty_print mtz status =
90 replicate bar_length '-',
94 join "\n" user_timeline_urls,
97 sca = show_created_at mtz status
98 name = screen_name (user status)
99 user_timeline_urls = listify (make_user_timeline_urls status)
100 bar_length = (length name) + 3 + (length sca)
103 -- | Given a list of statuses, returns the greatest status_id
104 -- belonging to one of the statuses in the list.
105 get_max_status_id :: Timeline -> Integer
106 get_max_status_id statuses =
109 status_ids = map status_id statuses
112 -- | Parse one username from a word.
113 parse_username :: String -> Maybe String
114 parse_username word =
118 Just (first_match:_) -> Just first_match
120 username_regex = mkRegex "@([a-zA-Z0-9_]+)"
121 matches = matchRegex username_regex word
124 -- | Parse all usernames of the form \@username from a status.
125 parse_usernames_from_status :: Status -> [String]
126 parse_usernames_from_status status =
127 mapMaybe parse_username status_words
129 status_words = splitWs (text status)
131 -- | Get all referenced users' timeline URLs.
132 make_user_timeline_urls :: Status -> [String]
133 make_user_timeline_urls status =
134 map screen_name_to_timeline_url usernames
136 usernames = parse_usernames_from_status status
139 status_tests :: [Test]
140 status_tests = [ test_parse_usernames ]
143 test_parse_usernames :: Test
144 test_parse_usernames =
147 "All usernames are parsed."
151 dummy_user = User { screen_name = "nobody" }
152 dummy_status = Status { status_id = 1,
153 created_at = Nothing,
154 text = "Hypothesis: @donsbot and @bonus500 are two personalities belonging to the same person.",
160 actual_usernames = parse_usernames_from_status dummy_status
161 expected_usernames = ["donsbot", "bonus500"]