]> gitweb.michael.orlitzky.com - dead/halcyon.git/blob - src/Twitter/Status.hs
506a2c0bbe26ff67a561e7eee6b2e73d0629fb9f
[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 (Show, Eq)
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_status_time :: String -> Maybe UTCTime
69 parse_status_time =
70 parseTime defaultTimeLocale status_format
71 where
72 -- | Should match e.g. "Sun Oct 24 18:21:41 +0000 2010"
73 status_format :: String
74 status_format = "%a %b %d %H:%M:%S %z %Y"
75
76 utc_time_to_rfc822 :: Maybe TimeZone -> UTCTime -> String
77 utc_time_to_rfc822 mtz utc =
78 case mtz of
79 Nothing -> foo utc
80 Just tz -> foo $ utcToZonedTime tz utc
81 where
82 foo = formatTime defaultTimeLocale rfc822DateFormat
83
84
85 show_created_at :: Maybe TimeZone -> Status -> String
86 show_created_at mtz =
87 (maybe "" (utc_time_to_rfc822 mtz)) . created_at
88
89 -- | Returns a nicely-formatted String representing the given 'Status'
90 -- object.
91 --
92 pretty_print :: Maybe TimeZone -> Status -> String
93 pretty_print mtz status =
94 concat [ name,
95 " - ",
96 sca,
97 "\n",
98 replicate bar_length '-',
99 "\n",
100 text status,
101 "\n\n",
102 join "\n" user_timeline_urls,
103 "\n" ]
104 where
105 sca = show_created_at mtz status
106 name = screen_name (user status)
107 user_timeline_urls = listify (make_user_timeline_urls status)
108 bar_length = (length name) + 3 + (length sca)
109
110
111 -- | Given a list of statuses, returns the greatest status_id
112 -- belonging to one of the statuses in the list.
113 --
114 get_max_status_id :: Timeline -> Integer
115 get_max_status_id statuses =
116 maximum status_ids
117 where
118 status_ids = map status_id statuses
119
120
121 -- | Parse one username from a word.
122 --
123 parse_username :: String -> Maybe String
124 parse_username word =
125 case matches of
126 Nothing -> Nothing
127 Just [] -> Nothing
128 Just (first_match:_) -> Just first_match
129 where
130 username_regex = mkRegex "@([a-zA-Z0-9_]+)"
131 matches = matchRegex username_regex word
132
133
134 -- | Parse all usernames of the form \@username from a status.
135 --
136 parse_usernames_from_status :: Status -> [String]
137 parse_usernames_from_status status =
138 mapMaybe parse_username status_words
139 where
140 status_words = splitWs (text status)
141
142
143 -- | Get all referenced users' timeline URLs.
144 --
145 make_user_timeline_urls :: Status -> [String]
146 make_user_timeline_urls status =
147 map screen_name_to_timeline_url usernames
148 where
149 usernames = parse_usernames_from_status status
150
151
152 status_tests :: TestTree
153 status_tests =
154 testGroup "Status Tests" [ test_parse_usernames ]
155
156
157 test_parse_usernames :: TestTree
158 test_parse_usernames =
159 testCase description $ actual @?= expected
160 where
161 description = "all usernames are parsed"
162
163 dummy_user = User { screen_name = "nobody" }
164 dummy_text = "Hypothesis: @donsbot and @bonus500 are two " ++
165 "personalities belonging to the same person."
166 dummy_status = Status { status_id = 1,
167 created_at = Nothing,
168 text = dummy_text,
169 user = dummy_user,
170 reply = False,
171 retweeted = False
172 }
173
174 actual = parse_usernames_from_status dummy_status
175 expected = ["donsbot", "bonus500"]