]> gitweb.michael.orlitzky.com - dead/halcyon.git/blob - src/Twitter/Status.hs
ba27d527d44f14ceeb3c6766e326d24d8beae501
[dead/halcyon.git] / src / Twitter / Status.hs
1 {-# LANGUAGE NoMonomorphismRestriction #-}
2
3 -- | Functions and data for working with Twitter statuses.
4 module Twitter.Status (
5 Status(..),
6 Timeline,
7 get_max_status_id,
8 pretty_print,
9 status_tests,
10 utc_time_to_rfc822 )
11 where
12
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 )
27 import Text.Regex ( matchRegex, mkRegex )
28
29 import Html ( replace_entities )
30 import StringUtils ( listify )
31 import Twitter.User ( User(..), screen_name_to_timeline_url )
32
33 data Status = Status {
34 created_at :: Maybe UTCTime,
35 status_id :: Integer,
36 reply :: Bool,
37 retweeted :: Bool,
38 text :: String,
39 user :: User }
40 deriving (Eq, Show)
41
42 type Timeline = [Status]
43
44 instance FromJSON Status where
45 parseJSON (Object t) =
46 Status <$>
47 liftM parse_status_time (t .: created_at_field) <*>
48 (t .: id_field) <*>
49 liftM isJustInt (t .: in_reply_to_status_id_field) <*>
50 (t .: retweeted_field) <*>
51 liftM replace_entities (t .: text_field) <*>
52 (t .: user_field)
53 where
54 -- The typechecker flips out without this.
55 isJustInt :: Maybe Int -> Bool
56 isJustInt = isJust
57
58 created_at_field = pack "created_at"
59 id_field = pack "id"
60 in_reply_to_status_id_field = pack "in_reply_to_status_id"
61 retweeted_field = pack "retweeted"
62 text_field = pack "text"
63 user_field = pack "user"
64
65 -- Do whatever.
66 parseJSON _ = mempty
67
68 -- | Parse a timestamp from a status into a UTCTime (or Nothing).
69 --
70 parse_status_time :: String -> Maybe UTCTime
71 parse_status_time =
72 parseTime defaultTimeLocale status_format
73 where
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"
77
78
79 -- | Given a 'TimeZone', convert a 'UTCTime' into an RFC822-format
80 -- time string. If no 'TimeZone' is given, assume UTC.
81 --
82 utc_time_to_rfc822 :: Maybe TimeZone -> UTCTime -> String
83 utc_time_to_rfc822 mtz utc =
84 case mtz of
85 Nothing -> foo utc
86 Just tz -> foo $ utcToZonedTime tz utc
87 where
88 foo = formatTime defaultTimeLocale rfc822DateFormat
89
90
91 -- | Get the 'created_at' time out of a 'Status' and display it as an
92 -- RFC822-format time string. If there's no created-at time in the
93 -- status, you'll get an empty string instead.
94 --
95 show_created_at :: Maybe TimeZone -> Status -> String
96 show_created_at mtz =
97 (maybe "" (utc_time_to_rfc822 mtz)) . created_at
98
99
100 -- | Returns a nicely-formatted String representing the given 'Status'
101 -- object.
102 --
103 pretty_print :: Maybe TimeZone -> Status -> String
104 pretty_print mtz status =
105 concat [ name,
106 " - ",
107 sca,
108 "\n",
109 replicate bar_length '-',
110 "\n",
111 text status,
112 "\n\n",
113 join "\n" user_timeline_urls,
114 "\n" ]
115 where
116 sca = show_created_at mtz status
117 name = screen_name (user status)
118 user_timeline_urls = listify (make_user_timeline_urls status)
119 bar_length = (length name) + 3 + (length sca)
120
121
122 -- | Given a list of statuses, returns the greatest status_id
123 -- belonging to one of the statuses in the list.
124 --
125 get_max_status_id :: Timeline -> Integer
126 get_max_status_id statuses =
127 maximum status_ids
128 where
129 status_ids = map status_id statuses
130
131
132 -- | Parse one username from a word.
133 --
134 parse_username :: String -> Maybe String
135 parse_username word =
136 case matches of
137 Nothing -> Nothing
138 Just [] -> Nothing
139 Just (first_match:_) -> Just first_match
140 where
141 username_regex = mkRegex "@([a-zA-Z0-9_]+)"
142 matches = matchRegex username_regex word
143
144
145 -- | Parse all usernames of the form \@username from a status.
146 --
147 parse_usernames_from_status :: Status -> [String]
148 parse_usernames_from_status status =
149 mapMaybe parse_username status_words
150 where
151 status_words = splitWs (text status)
152
153
154 -- | Get all referenced users' timeline URLs.
155 --
156 make_user_timeline_urls :: Status -> [String]
157 make_user_timeline_urls status =
158 map screen_name_to_timeline_url usernames
159 where
160 usernames = parse_usernames_from_status status
161
162
163 status_tests :: TestTree
164 status_tests =
165 testGroup "Status Tests" [ test_parse_usernames ]
166
167
168 test_parse_usernames :: TestTree
169 test_parse_usernames =
170 testCase description $ actual @?= expected
171 where
172 description = "all usernames are parsed"
173
174 dummy_user = User { screen_name = "nobody" }
175 dummy_text = "Hypothesis: @donsbot and @bonus500 are two " ++
176 "personalities belonging to the same person."
177 dummy_status = Status { status_id = 1,
178 created_at = Nothing,
179 text = dummy_text,
180 user = dummy_user,
181 reply = False,
182 retweeted = False
183 }
184
185 actual = parse_usernames_from_status dummy_status
186 expected = ["donsbot", "bonus500"]