src/Twitter/Status.hs

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