From 518f0ba7d66d93fdda2a5dd7b8ea90b59d874b27 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Wed, 16 Jul 2014 15:18:49 -0400 Subject: [PATCH] Add more tests and remove the dependency on regex-compat. --- halcyon.cabal | 2 - src/Twitter/Http.hs | 5 ++ src/Twitter/Status.hs | 128 ++++++++++++++++++++++++++++++++++++++---- src/Twitter/User.hs | 14 ++++- 4 files changed, 135 insertions(+), 14 deletions(-) diff --git a/halcyon.cabal b/halcyon.cabal index dfbd174..877d6ab 100644 --- a/halcyon.cabal +++ b/halcyon.cabal @@ -29,7 +29,6 @@ executable halcyon MissingH >= 1.2, process >= 1.1, old-locale >= 1, - regex-compat == 0.*, tagsoup >= 0.13, text >= 1.1, time >= 1.4, @@ -88,7 +87,6 @@ test-suite testsuite MissingH >= 1.2, process >= 1.1, old-locale >= 1, - regex-compat == 0.*, tagsoup >= 0.13, text >= 1.1, time >= 1.4, diff --git a/src/Twitter/Http.hs b/src/Twitter/Http.hs index eec7ab7..21e47ba 100644 --- a/src/Twitter/Http.hs +++ b/src/Twitter/Http.hs @@ -44,6 +44,11 @@ user_timeline_url username = -- username's new statuses. Essentially, 'user_timeline_url' with a -- \"since_id\" parameter tacked on. -- +-- Examples: +-- +-- >>> user_new_statuses_url "someuser" 8675309 +-- "https://api.twitter.com/1.1/statuses/user_timeline.json?screen_name=someuser&include_rts=true&count=10&since_id=8675309" +-- user_new_statuses_url :: String -> Integer -> String user_new_statuses_url username last_status_id = url ++ "&since_id=" ++ since_id diff --git a/src/Twitter/Status.hs b/src/Twitter/Status.hs index ba27d52..640072c 100644 --- a/src/Twitter/Status.hs +++ b/src/Twitter/Status.hs @@ -24,12 +24,16 @@ 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 ) + +-- | Representation of a Twitter user status. We only care about a few +-- of the fields, and those are all that we bother to include in the +-- representation. +-- data Status = Status { created_at :: Maybe UTCTime, status_id :: Integer, @@ -41,7 +45,11 @@ data Status = Status { type Timeline = [Status] + instance FromJSON Status where + -- | Use a bunch of applicative magic to parse a 'Status' out of the + -- JSON that we get from the Twitter API. + -- parseJSON (Object t) = Status <$> liftM parse_status_time (t .: created_at_field) <*> @@ -51,7 +59,9 @@ instance FromJSON Status where liftM replace_entities (t .: text_field) <*> (t .: user_field) where - -- The typechecker flips out without this. + -- | The typechecker flips out without this; it's just a copy if + -- 'isJust' specialized to the 'Int' type. + -- isJustInt :: Maybe Int -> Bool isJustInt = isJust @@ -65,13 +75,22 @@ instance FromJSON Status where -- Do whatever. parseJSON _ = mempty + -- | Parse a timestamp from a status into a UTCTime (or Nothing). -- +-- Examples: +-- +-- >>> let s = "Sun Oct 24 18:21:41 +0000 2010" +-- >>> parse_status_time s +-- Just 2010-10-24 18:21:41 UTC +-- +-- >>> parse_status_time "what's up dawg" +-- Nothing +-- parse_status_time :: String -> Maybe UTCTime parse_status_time = parseTime defaultTimeLocale status_format where - -- | Should match e.g. "Sun Oct 24 18:21:41 +0000 2010" status_format :: String status_format = "%a %b %d %H:%M:%S %z %Y" @@ -79,6 +98,13 @@ parse_status_time = -- | Given a 'TimeZone', convert a 'UTCTime' into an RFC822-format -- time string. If no 'TimeZone' is given, assume UTC. -- +-- Examples: +-- +-- >>> let s = "Sun Oct 24 18:21:41 +0000 2010" +-- >>> let Just t = parse_status_time s +-- >>> utc_time_to_rfc822 Nothing t +-- "Sun, 24 Oct 2010 18:21:41 UTC" +-- utc_time_to_rfc822 :: Maybe TimeZone -> UTCTime -> String utc_time_to_rfc822 mtz utc = case mtz of @@ -92,6 +118,14 @@ utc_time_to_rfc822 mtz utc = -- RFC822-format time string. If there's no created-at time in the -- status, you'll get an empty string instead. -- +-- >>> let u = User "washington_irving" +-- >>> let created = parse_status_time "Sun Oct 24 18:21:41 +0000 2010" +-- >>> let s = Status created 8675309 False False "IM TWITTERING" u +-- >>> show_created_at Nothing s +-- "Sun, 24 Oct 2010 18:21:41 UTC" +-- >>> show_created_at Nothing s{ created_at = Nothing } +-- "" +-- show_created_at :: Maybe TimeZone -> Status -> String show_created_at mtz = (maybe "" (utc_time_to_rfc822 mtz)) . created_at @@ -100,6 +134,18 @@ show_created_at mtz = -- | Returns a nicely-formatted String representing the given 'Status' -- object. -- +-- Examples: +-- +-- >>> let u = User "washington_irving" +-- >>> let created = parse_status_time "Sun Oct 24 18:21:41 +0000 2010" +-- >>> let s = Status created 8675309 False False "IM TWITTERING" u +-- >>> putStr $ pretty_print Nothing s +-- washington_irving - Sun, 24 Oct 2010 18:21:41 UTC +-- ------------------------------------------------- +-- IM TWITTERING +-- +-- +-- pretty_print :: Maybe TimeZone -> Status -> String pretty_print mtz status = concat [ name, @@ -122,6 +168,15 @@ pretty_print mtz status = -- | Given a list of statuses, returns the greatest status_id -- belonging to one of the statuses in the list. -- +-- Examples: +-- +-- >>> let u = User "washington_irving" +-- >>> let created = parse_status_time "Sun Oct 24 18:21:41 +0000 2010" +-- >>> let s = Status created 8675309 False False "IM TWITTERING" u +-- >>> let timeline = [s,s,s,s,s] +-- >>> get_max_status_id timeline +-- 8675309 +-- get_max_status_id :: Timeline -> Integer get_max_status_id statuses = maximum status_ids @@ -129,21 +184,72 @@ get_max_status_id statuses = status_ids = map status_id statuses --- | Parse one username from a word. +-- | Parse one username from a 'String'. +-- +-- Examples: +-- +-- >>> parse_username "@washington_irving" +-- Just "washington_irving" +-- >>> parse_username "washington_irving" +-- Nothing +-- >>> parse_username "Everbody loves @washington_irving, even Raymond" +-- Just "washington_irving" +-- +-- >>> parse_username "herp @@@ derp @washington_irving foo@@BAR" +-- Just "washington_irving" +-- +-- >>> parse_username "tailing at sign y'all @" +-- Nothing -- parse_username :: String -> Maybe String -parse_username word = - case matches of - Nothing -> Nothing - Just [] -> Nothing - Just (first_match:_) -> Just first_match +parse_username s + | null parse_result = Nothing + | otherwise = Just parse_result where - username_regex = mkRegex "@([a-zA-Z0-9_]+)" - matches = matchRegex username_regex word + -- | A list of characters valid in a Twitter username. + -- + username_chars :: String + username_chars = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "_" + + -- | Take a string and drop everything (including the \'@\') up to + -- the first character of the first username (if one exists). + -- + start_name :: String -> String + start_name w = + case dropWhile (/= '@') w of + [] -> [] + (_:xs) -> xs + + parse_userchars :: String -> String + parse_userchars = takeWhile (`elem` username_chars) + + -- | Parse a username from the given String by dropping all + -- characters that don't belong to it. This function calls + -- itself recursively until it gets a username or runs out of + -- string. + -- + parse_name :: String -> String + parse_name [] = [] + parse_name rest@(_:xs) = + let ucs = (parse_userchars . start_name) rest in + case ucs of + [] -> parse_name xs + _ -> ucs + + parse_result :: String + parse_result = parse_name s -- | Parse all usernames of the form \@username from a status. -- +-- Examples: +-- +-- >>> let u = User "washington_irving" +-- >>> let b = "YO WHERE'S @BONUS500 and @@@ I LOVE @AT SIGNS@" +-- >>> let s = Status Nothing 8675309 False False b u +-- >>> parse_usernames_from_status s +-- ["BONUS500","AT"] +-- parse_usernames_from_status :: Status -> [String] parse_usernames_from_status status = mapMaybe parse_username status_words diff --git a/src/Twitter/User.hs b/src/Twitter/User.hs index 071b063..af3bc1c 100644 --- a/src/Twitter/User.hs +++ b/src/Twitter/User.hs @@ -9,11 +9,16 @@ import Data.Aeson ( (.:), FromJSON(..), Value(Object) ) import Data.Text ( pack ) import Data.Monoid ( mempty ) + -- | Represents a Twitter user, and contains the only attribute -- thereof that we care about: the screen (user) name. +-- data User = User { screen_name :: String } deriving (Eq, Show) instance FromJSON User where + -- | Parse the JSON we get from the Twitter API into a 'User' if we + -- can. + -- parseJSON (Object u) = User <$> (u .: screen_name_field) where @@ -22,7 +27,14 @@ instance FromJSON User where -- Do whatever. parseJSON _ = mempty --- |Get the URL for the given screen name's timeline. + +-- | Get the URL for the given screen name's timeline. +-- +-- Examples: +-- +-- >>> screen_name_to_timeline_url "washington_irving" +-- "http://twitter.com/washington_irving" +-- screen_name_to_timeline_url :: String -> String screen_name_to_timeline_url = ("http://twitter.com/" ++) -- 2.43.2