+{-# LANGUAGE NoMonomorphismRestriction #-}
+
-- | Functions and data for working with Twitter statuses.
-module Twitter.Status
+module Twitter.Status (
+ Status(..),
+ Timeline,
+ get_max_status_id,
+ pretty_print,
+ status_tests,
+ utc_time_to_rfc822 )
where
-import Control.Applicative ((<$>), (<*>))
-import Control.Monad (liftM)
-import Data.Aeson ((.:), FromJSON(..), Value(Object))
-import Data.Maybe (catMaybes, isJust)
-import Data.Monoid (mempty)
-import Data.String.Utils (join, splitWs)
-import Data.Text (pack)
-import Data.Time (formatTime)
-import Data.Time.Clock (UTCTime)
-import Data.Time.Format (parseTime)
-import Data.Time.LocalTime (TimeZone, utcToZonedTime)
-import System.Locale (defaultTimeLocale, rfc822DateFormat)
-import Test.HUnit
-import Text.Regex (matchRegex, mkRegex)
-
-import StringUtils (listify)
-import Twitter.User
+import Control.Applicative ( (<$>), (<*>) )
+import Control.Monad ( liftM )
+import Data.Aeson ( (.:), FromJSON(..), Value(Object) )
+import Data.Maybe ( mapMaybe, isJust )
+import Data.Monoid ( mempty )
+import Data.String.Utils ( join, splitWs )
+import Data.Text ( pack )
+import Data.Time ( formatTime )
+import Data.Time.Clock ( UTCTime )
+import Data.Time.Format ( parseTime )
+import Data.Time.LocalTime ( TimeZone, utcToZonedTime )
+import System.Locale ( defaultTimeLocale, rfc822DateFormat )
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.HUnit ( (@?=), testCase )
+import Text.Regex ( matchRegex, mkRegex )
+
+import Html ( replace_entities )
+import StringUtils ( listify )
+import Twitter.User ( User(..), screen_name_to_timeline_url )
data Status = Status {
created_at :: Maybe UTCTime,
reply :: Bool,
retweeted :: Bool,
text :: String,
- user :: User
- } deriving (Show, Eq)
+ user :: User }
+ deriving (Eq, Show)
type Timeline = [Status]
(t .: id_field) <*>
liftM isJustInt (t .: in_reply_to_status_id_field) <*>
(t .: retweeted_field) <*>
- (t .: text_field) <*>
+ liftM replace_entities (t .: text_field) <*>
(t .: user_field)
where
-- The typechecker flips out without this.
-- Do whatever.
parseJSON _ = mempty
+-- | Parse a timestamp from a status into a UTCTime (or Nothing).
+--
parse_status_time :: String -> Maybe UTCTime
parse_status_time =
parseTime defaultTimeLocale status_format
status_format :: String
status_format = "%a %b %d %H:%M:%S %z %Y"
+
+-- | Given a 'TimeZone', convert a 'UTCTime' into an RFC822-format
+-- time string. If no 'TimeZone' is given, assume UTC.
+--
utc_time_to_rfc822 :: Maybe TimeZone -> UTCTime -> String
utc_time_to_rfc822 mtz utc =
case mtz of
foo = formatTime defaultTimeLocale rfc822DateFormat
+-- | Get the 'created_at' time out of a 'Status' and display it as an
+-- RFC822-format time string. If there's no created-at time in the
+-- status, you'll get an empty string instead.
+--
show_created_at :: Maybe TimeZone -> Status -> String
show_created_at mtz =
- (maybe "" id) . (fmap $ utc_time_to_rfc822 mtz) . created_at
+ (maybe "" (utc_time_to_rfc822 mtz)) . created_at
+
-- | Returns a nicely-formatted String representing the given 'Status'
-- object.
+--
pretty_print :: Maybe TimeZone -> Status -> String
pretty_print mtz status =
concat [ name,
-- | Given a list of statuses, returns the greatest status_id
-- belonging to one of the statuses in the list.
+--
get_max_status_id :: Timeline -> Integer
get_max_status_id statuses =
maximum status_ids
-- | Parse one username from a word.
+--
parse_username :: String -> Maybe String
parse_username word =
case matches of
-- | Parse all usernames of the form \@username from a status.
+--
parse_usernames_from_status :: Status -> [String]
parse_usernames_from_status status =
- catMaybes (map parse_username status_words)
+ mapMaybe parse_username status_words
where
status_words = splitWs (text status)
+
-- | Get all referenced users' timeline URLs.
+--
make_user_timeline_urls :: Status -> [String]
make_user_timeline_urls status =
map screen_name_to_timeline_url usernames
usernames = parse_usernames_from_status status
-status_tests :: [Test]
-status_tests = [ test_parse_usernames ]
+status_tests :: TestTree
+status_tests =
+ testGroup "Status Tests" [ test_parse_usernames ]
-test_parse_usernames :: Test
+test_parse_usernames :: TestTree
test_parse_usernames =
- TestCase $
- assertEqual
- "All usernames are parsed."
- expected_usernames
- actual_usernames
- where
- dummy_user = User { screen_name = "nobody" }
- dummy_status = Status { status_id = 1,
- created_at = Nothing,
- text = "Hypothesis: @donsbot and @bonus500 are two personalities belonging to the same person.",
- user = dummy_user,
- reply = False,
- retweeted = False
- }
-
- actual_usernames = parse_usernames_from_status dummy_status
- expected_usernames = ["donsbot", "bonus500"]
+ testCase description $ actual @?= expected
+ where
+ description = "all usernames are parsed"
+
+ dummy_user = User { screen_name = "nobody" }
+ dummy_text = "Hypothesis: @donsbot and @bonus500 are two " ++
+ "personalities belonging to the same person."
+ dummy_status = Status { status_id = 1,
+ created_at = Nothing,
+ text = dummy_text,
+ user = dummy_user,
+ reply = False,
+ retweeted = False
+ }
+
+ actual = parse_usernames_from_status dummy_status
+ expected = ["donsbot", "bonus500"]