X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=blobdiff_plain;f=src%2FTwitter%2FStatus.hs;h=3508593d2ee3af92472d734ee71815bef97ed744;hp=ef4e1037b9ca54b212f5666d60271ff832468301;hb=7bb00e04c15781d889f950d00babf3f183047bff;hpb=9b6d95a82745ced2a58d9bc4ded555ee36b36673 diff --git a/src/Twitter/Status.hs b/src/Twitter/Status.hs index ef4e103..3508593 100644 --- a/src/Twitter/Status.hs +++ b/src/Twitter/Status.hs @@ -1,11 +1,20 @@ +{-# 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.Maybe (mapMaybe, isJust) import Data.Monoid (mempty) import Data.String.Utils (join, splitWs) import Data.Text (pack) @@ -14,11 +23,14 @@ 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 Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit (Assertion, assertEqual) import Text.Regex (matchRegex, mkRegex) +import Html (replace_entities) import StringUtils (listify) -import Twitter.User +import Twitter.User (User(..), screen_name_to_timeline_url) data Status = Status { created_at :: Maybe UTCTime, @@ -38,7 +50,7 @@ instance FromJSON Status where (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. @@ -74,7 +86,7 @@ utc_time_to_rfc822 mtz utc = 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. @@ -121,7 +133,7 @@ parse_username word = -- | 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) @@ -133,26 +145,30 @@ make_user_timeline_urls status = usernames = parse_usernames_from_status status -status_tests :: [Test] -status_tests = [ test_parse_usernames ] +status_tests :: Test +status_tests = + testGroup "Status Tests" [ tc1 ] + where + tc1 = testCase "All usernames are parsed." test_parse_usernames -test_parse_usernames :: Test +test_parse_usernames :: Assertion 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"] + assertEqual + "All usernames are parsed." + expected_usernames + actual_usernames + where + 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_usernames = parse_usernames_from_status dummy_status + expected_usernames = ["donsbot", "bonus500"]