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)
19 import Test.Framework (Test, testGroup)
20 import Test.Framework.Providers.HUnit (testCase)
21 import Test.HUnit (Assertion, assertEqual)
22 import Text.Regex (matchRegex, mkRegex)
24 import Html (replace_entities)
25 import StringUtils (listify)
28 data Status = Status {
29 created_at :: Maybe UTCTime,
37 type Timeline = [Status]
39 instance FromJSON Status where
40 parseJSON (Object t) =
42 liftM parse_status_time (t .: created_at_field) <*>
44 liftM isJustInt (t .: in_reply_to_status_id_field) <*>
45 (t .: retweeted_field) <*>
46 liftM replace_entities (t .: text_field) <*>
49 -- The typechecker flips out without this.
50 isJustInt :: Maybe Int -> Bool
53 created_at_field = pack "created_at"
55 in_reply_to_status_id_field = pack "in_reply_to_status_id"
56 retweeted_field = pack "retweeted"
57 text_field = pack "text"
58 user_field = pack "user"
63 parse_status_time :: String -> Maybe UTCTime
65 parseTime defaultTimeLocale status_format
67 -- | Should match e.g. "Sun Oct 24 18:21:41 +0000 2010"
68 status_format :: String
69 status_format = "%a %b %d %H:%M:%S %z %Y"
71 utc_time_to_rfc822 :: Maybe TimeZone -> UTCTime -> String
72 utc_time_to_rfc822 mtz utc =
75 Just tz -> foo $ utcToZonedTime tz utc
77 foo = formatTime defaultTimeLocale rfc822DateFormat
80 show_created_at :: Maybe TimeZone -> Status -> String
82 (fromMaybe "") . (fmap $ utc_time_to_rfc822 mtz) . created_at
84 -- | Returns a nicely-formatted String representing the given 'Status'
86 pretty_print :: Maybe TimeZone -> Status -> String
87 pretty_print mtz status =
92 replicate bar_length '-',
96 join "\n" user_timeline_urls,
99 sca = show_created_at mtz status
100 name = screen_name (user status)
101 user_timeline_urls = listify (make_user_timeline_urls status)
102 bar_length = (length name) + 3 + (length sca)
105 -- | Given a list of statuses, returns the greatest status_id
106 -- belonging to one of the statuses in the list.
107 get_max_status_id :: Timeline -> Integer
108 get_max_status_id statuses =
111 status_ids = map status_id statuses
114 -- | Parse one username from a word.
115 parse_username :: String -> Maybe String
116 parse_username word =
120 Just (first_match:_) -> Just first_match
122 username_regex = mkRegex "@([a-zA-Z0-9_]+)"
123 matches = matchRegex username_regex word
126 -- | Parse all usernames of the form \@username from a status.
127 parse_usernames_from_status :: Status -> [String]
128 parse_usernames_from_status status =
129 mapMaybe parse_username status_words
131 status_words = splitWs (text status)
133 -- | Get all referenced users' timeline URLs.
134 make_user_timeline_urls :: Status -> [String]
135 make_user_timeline_urls status =
136 map screen_name_to_timeline_url usernames
138 usernames = parse_usernames_from_status status
143 testGroup "Status Tests" [ tc1 ]
145 tc1 = testCase "All usernames are parsed." test_parse_usernames
148 test_parse_usernames :: Assertion
149 test_parse_usernames =
151 "All usernames are parsed."
155 dummy_user = User { screen_name = "nobody" }
156 dummy_text = "Hypothesis: @donsbot and @bonus500 are two " ++
157 "personalities belonging to the same person."
158 dummy_status = Status { status_id = 1,
159 created_at = Nothing,
166 actual_usernames = parse_usernames_from_status dummy_status
167 expected_usernames = ["donsbot", "bonus500"]