src/Twitter/Status.hs

   1 -- | Functions and data for working with Twitter statuses.
   2 module Twitter.Status
   3 where
   4
   5 import Control.Applicative ((<$>), (<*>))
   6 import Control.Monad (liftM)
   7 import Data.Aeson ((.:), FromJSON(..), Value(Object))
   8 import Data.Maybe (catMaybes, isJust)
   9 import Data.Monoid (mempty)
  10 import Data.String.Utils (join, splitWs)
  11 import Data.Text (pack)
  12 import Data.Time (formatTime)
  13 import Data.Time.Clock (UTCTime)
  14 import Data.Time.Format (parseTime)
  15 import Data.Time.LocalTime (TimeZone, utcToZonedTime)
  16 import System.Locale (defaultTimeLocale, rfc822DateFormat)
  17 import Test.HUnit
  18 import Text.Regex (matchRegex, mkRegex)
  19
  20 import StringUtils (listify)
  21 import Twitter.User
  22
  23 data Status = Status {
  24   created_at :: Maybe UTCTime,
  25   status_id   :: Integer,
  26   reply :: Bool,
  27   retweeted :: Bool,
  28   text :: String,
  29   user :: User
  30   } deriving (Show, Eq)
  31
  32 type Timeline = [Status]
  33
  34 instance FromJSON Status where
  35   parseJSON (Object t) =
  36     Status <$>
  37       liftM parse_status_time (t .: created_at_field) <*>
  38       (t .: id_field) <*>
  39       liftM isJustInt (t .: in_reply_to_status_id_field) <*>
  40       (t .: retweeted_field) <*>
  41       (t .: text_field) <*>
  42       (t .: user_field)
  43     where
  44       -- The typechecker flips out without this.
  45       isJustInt :: Maybe Int -> Bool
  46       isJustInt = isJust
  47
  48       created_at_field = pack "created_at"
  49       id_field = pack "id"
  50       in_reply_to_status_id_field = pack "in_reply_to_status_id"
  51       retweeted_field = pack "retweeted"
  52       text_field = pack "text"
  53       user_field = pack "user"
  54
  55   -- Do whatever.
  56   parseJSON _ = mempty
  57
  58 parse_status_time :: String -> Maybe UTCTime
  59 parse_status_time =
  60   parseTime defaultTimeLocale status_format
  61   where
  62     -- | Should match e.g. "Sun Oct 24 18:21:41 +0000 2010"
  63     status_format :: String
  64     status_format = "%a %b %d %H:%M:%S %z %Y"
  65
  66 utc_time_to_rfc822 :: Maybe TimeZone -> UTCTime -> String
  67 utc_time_to_rfc822 mtz utc =
  68   case mtz of
  69     Nothing ->  foo utc
  70     Just tz -> foo $ utcToZonedTime tz utc
  71   where
  72     foo = formatTime defaultTimeLocale rfc822DateFormat
  73
  74
  75 show_created_at :: Maybe TimeZone -> Status -> String
  76 show_created_at mtz =
  77   (maybe "" id) . (fmap $ utc_time_to_rfc822 mtz) . created_at
  78
  79 -- | Returns a nicely-formatted String representing the given 'Status'
  80 --   object.
  81 pretty_print :: Maybe TimeZone -> Status -> String
  82 pretty_print mtz status =
  83   concat [ name,
  84            " - ",
  85            sca,
  86            "\n",
  87            replicate bar_length '-',
  88            "\n",
  89            text status,
  90            "\n\n",
  91            join "\n" user_timeline_urls,
  92            "\n" ]
  93   where
  94     sca = show_created_at mtz status
  95     name = screen_name (user status)
  96     user_timeline_urls = listify (make_user_timeline_urls status)
  97     bar_length = (length name) + 3 + (length sca)
  98
  99
 100 -- | Given a list of statuses, returns the greatest status_id
 101 --   belonging to one of the statuses in the list.
 102 get_max_status_id :: Timeline -> Integer
 103 get_max_status_id statuses =
 104   maximum status_ids
 105   where
 106     status_ids = map status_id statuses
 107
 108
 109 -- | Parse one username from a word.
 110 parse_username :: String -> Maybe String
 111 parse_username word =
 112   case matches of
 113     Nothing -> Nothing
 114     Just [] -> Nothing
 115     Just (first_match:_) -> Just first_match
 116   where
 117     username_regex = mkRegex "@([a-zA-Z0-9_]+)"
 118     matches = matchRegex username_regex word
 119
 120
 121 -- | Parse all usernames of the form \@username from a status.
 122 parse_usernames_from_status :: Status -> [String]
 123 parse_usernames_from_status status =
 124   catMaybes (map parse_username status_words)
 125   where
 126     status_words = splitWs (text status)
 127
 128 -- | Get all referenced users' timeline URLs.
 129 make_user_timeline_urls :: Status -> [String]
 130 make_user_timeline_urls status =
 131   map screen_name_to_timeline_url usernames
 132   where
 133     usernames = parse_usernames_from_status status
 134
 135
 136 status_tests :: [Test]
 137 status_tests = [ test_parse_usernames ]
 138
 139
 140 test_parse_usernames :: Test
 141 test_parse_usernames =
 142     TestCase $
 143       assertEqual
 144       "All usernames are parsed."
 145       expected_usernames
 146       actual_usernames
 147     where
 148       dummy_user = User { screen_name = "nobody" }
 149       dummy_status = Status { status_id = 1,
 150                               created_at = Nothing,
 151                               text = "Hypothesis: @donsbot and @bonus500 are two personalities belonging to the same person.",
 152                               user = dummy_user,
 153                               reply = False,
 154                               retweeted = False
 155                             }
 156
 157       actual_usernames = parse_usernames_from_status dummy_status
 158       expected_usernames = ["donsbot", "bonus500"]