src/Twitter/Status.hs

   1 {-# LANGUAGE NoMonomorphismRestriction #-}
   2
   3 -- | Functions and data for working with Twitter statuses.
   4 module Twitter.Status (
   5   Status(..),
   6   Timeline,
   7   get_max_status_id,
   8   pretty_print,
   9   status_tests,
  10   utc_time_to_rfc822 )
  11 where
  12
  13 import Control.Applicative ( (<$>), (<*>) )
  14 import Control.Monad ( liftM )
  15 import Data.Aeson ( (.:), FromJSON(..), Value(Object) )
  16 import Data.Maybe ( mapMaybe, isJust )
  17 import Data.Monoid ( mempty )
  18 import Data.String.Utils ( join, splitWs )
  19 import Data.Text ( pack )
  20 import Data.Time ( formatTime )
  21 import Data.Time.Clock ( UTCTime )
  22 import Data.Time.Format ( parseTime )
  23 import Data.Time.LocalTime ( TimeZone, utcToZonedTime )
  24 import System.Locale ( defaultTimeLocale, rfc822DateFormat )
  25 import Test.Tasty ( TestTree, testGroup )
  26 import Test.Tasty.HUnit ( (@?=), testCase )
  27
  28 import Html ( replace_entities )
  29 import StringUtils ( listify )
  30 import Twitter.User ( User(..), screen_name_to_timeline_url )
  31
  32
  33 -- | Representation of a Twitter user status. We only care about a few
  34 --   of the fields, and those are all that we bother to include in the
  35 --   representation.
  36 --
  37 data Status = Status {
  38   created_at :: Maybe UTCTime,
  39   status_id   :: Integer,
  40   reply :: Bool,
  41   retweeted :: Bool,
  42   text :: String,
  43   user :: User }
  44   deriving (Eq, Show)
  45
  46 type Timeline = [Status]
  47
  48
  49 instance FromJSON Status where
  50   -- | Use a bunch of applicative magic to parse a 'Status' out of the
  51   --   JSON that we get from the Twitter API.
  52   --
  53   parseJSON (Object t) =
  54     Status <$>
  55       liftM parse_status_time (t .: created_at_field) <*>
  56       (t .: id_field) <*>
  57       liftM isJustInt (t .: in_reply_to_status_id_field) <*>
  58       (t .: retweeted_field) <*>
  59       liftM replace_entities (t .: text_field) <*>
  60       (t .: user_field)
  61     where
  62       -- | The typechecker flips out without this; it's just a copy if
  63       --   'isJust' specialized to the 'Int' type.
  64       --
  65       isJustInt :: Maybe Int -> Bool
  66       isJustInt = isJust
  67
  68       created_at_field = pack "created_at"
  69       id_field = pack "id"
  70       in_reply_to_status_id_field = pack "in_reply_to_status_id"
  71       retweeted_field = pack "retweeted"
  72       text_field = pack "text"
  73       user_field = pack "user"
  74
  75   -- Do whatever.
  76   parseJSON _ = mempty
  77
  78
  79 -- | Parse a timestamp from a status into a UTCTime (or Nothing).
  80 --
  81 --   Examples:
  82 --
  83 --   >>> let s = "Sun Oct 24 18:21:41 +0000 2010"
  84 --   >>> parse_status_time s
  85 --   Just 2010-10-24 18:21:41 UTC
  86 --
  87 --   >>> parse_status_time "what's up dawg"
  88 --   Nothing
  89 --
  90 parse_status_time :: String -> Maybe UTCTime
  91 parse_status_time =
  92   parseTime defaultTimeLocale status_format
  93   where
  94     status_format :: String
  95     status_format = "%a %b %d %H:%M:%S %z %Y"
  96
  97
  98 -- | Given a 'TimeZone', convert a 'UTCTime' into an RFC822-format
  99 --   time string. If no 'TimeZone' is given, assume UTC.
 100 --
 101 --   Examples:
 102 --
 103 --   >>> let s = "Sun Oct 24 18:21:41 +0000 2010"
 104 --   >>> let Just t = parse_status_time s
 105 --   >>> utc_time_to_rfc822 Nothing t
 106 --   "Sun, 24 Oct 2010 18:21:41 UTC"
 107 --
 108 utc_time_to_rfc822 :: Maybe TimeZone -> UTCTime -> String
 109 utc_time_to_rfc822 mtz utc =
 110   case mtz of
 111     Nothing ->  foo utc
 112     Just tz -> foo $ utcToZonedTime tz utc
 113   where
 114     foo = formatTime defaultTimeLocale rfc822DateFormat
 115
 116
 117 -- | Get the 'created_at' time out of a 'Status' and display it as an
 118 --   RFC822-format time string. If there's no created-at time in the
 119 --   status, you'll get an empty string instead.
 120 --
 121 --   >>> let u = User "washington_irving"
 122 --   >>> let created = parse_status_time "Sun Oct 24 18:21:41 +0000 2010"
 123 --   >>> let s = Status created 8675309 False False "IM TWITTERING" u
 124 --   >>> show_created_at Nothing s
 125 --   "Sun, 24 Oct 2010 18:21:41 UTC"
 126 --   >>> show_created_at Nothing s{ created_at = Nothing }
 127 --   ""
 128 --
 129 show_created_at :: Maybe TimeZone -> Status -> String
 130 show_created_at mtz =
 131   (maybe "" (utc_time_to_rfc822 mtz)) . created_at
 132
 133
 134 -- | Returns a nicely-formatted String representing the given 'Status'
 135 --   object.
 136 --
 137 --   Examples:
 138 --
 139 --   >>> let u = User "washington_irving"
 140 --   >>> let created = parse_status_time "Sun Oct 24 18:21:41 +0000 2010"
 141 --   >>> let s = Status created 8675309 False False "IM TWITTERING" u
 142 --   >>> putStr $ pretty_print Nothing s
 143 --   washington_irving - Sun, 24 Oct 2010 18:21:41 UTC
 144 --   -------------------------------------------------
 145 --   IM TWITTERING
 146 --   <BLANKLINE>
 147 --   <BLANKLINE>
 148 --
 149 pretty_print :: Maybe TimeZone -> Status -> String
 150 pretty_print mtz status =
 151   concat [ name,
 152            " - ",
 153            sca,
 154            "\n",
 155            replicate bar_length '-',
 156            "\n",
 157            text status,
 158            "\n\n",
 159            join "\n" user_timeline_urls,
 160            "\n" ]
 161   where
 162     sca = show_created_at mtz status
 163     name = screen_name (user status)
 164     user_timeline_urls = listify (make_user_timeline_urls status)
 165     bar_length = (length name) + 3 + (length sca)
 166
 167
 168 -- | Given a list of statuses, returns the greatest status_id
 169 --   belonging to one of the statuses in the list.
 170 --
 171 --   Examples:
 172 --
 173 --   >>> let u = User "washington_irving"
 174 --   >>> let created = parse_status_time "Sun Oct 24 18:21:41 +0000 2010"
 175 --   >>> let s = Status created 8675309 False False "IM TWITTERING" u
 176 --   >>> let timeline = [s,s,s,s,s]
 177 --   >>> get_max_status_id timeline
 178 --   8675309
 179 --
 180 get_max_status_id :: Timeline -> Integer
 181 get_max_status_id statuses =
 182   maximum status_ids
 183   where
 184     status_ids = map status_id statuses
 185
 186
 187 -- | Parse one username from a 'String'.
 188 --
 189 --   Examples:
 190 --
 191 --   >>> parse_username "@washington_irving"
 192 --   Just "washington_irving"
 193 --   >>> parse_username "washington_irving"
 194 --   Nothing
 195 --   >>> parse_username "Everbody loves @washington_irving, even Raymond"
 196 --   Just "washington_irving"
 197 --
 198 --   >>> parse_username "herp @@@ derp @washington_irving foo@@BAR"
 199 --   Just "washington_irving"
 200 --
 201 --   >>> parse_username "tailing at sign y'all @"
 202 --   Nothing
 203 --
 204 parse_username :: String -> Maybe String
 205 parse_username s
 206   | null parse_result = Nothing
 207   | otherwise = Just parse_result
 208   where
 209     -- | A list of characters valid in a Twitter username.
 210     --
 211     username_chars :: String
 212     username_chars = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "_"
 213
 214     -- | Take a string and drop everything (including the \'@\') up to
 215     --   the first character of the first username (if one exists).
 216     --
 217     start_name :: String -> String
 218     start_name w =
 219       case dropWhile (/= '@') w of
 220         [] -> []
 221         (_:xs) -> xs
 222
 223     parse_userchars :: String -> String
 224     parse_userchars = takeWhile (`elem` username_chars)
 225
 226     -- | Parse a username from the given String by dropping all
 227     --   characters that don't belong to it. This function calls
 228     --   itself recursively until it gets a username or runs out of
 229     --   string.
 230     --
 231     parse_name :: String -> String
 232     parse_name [] = []
 233     parse_name rest@(_:xs) =
 234       let ucs = (parse_userchars . start_name) rest in
 235                   case ucs of
 236                     []  -> parse_name xs
 237                     _  -> ucs
 238
 239     parse_result :: String
 240     parse_result = parse_name s
 241
 242
 243 -- | Parse all usernames of the form \@username from a status.
 244 --
 245 --   Examples:
 246 --
 247 --   >>> let u = User "washington_irving"
 248 --   >>> let b = "YO WHERE'S @BONUS500 and @@@ I LOVE @AT SIGNS@"
 249 --   >>> let s = Status Nothing 8675309 False False b u
 250 --   >>> parse_usernames_from_status s
 251 --   ["BONUS500","AT"]
 252 --
 253 parse_usernames_from_status :: Status -> [String]
 254 parse_usernames_from_status status =
 255   mapMaybe parse_username status_words
 256   where
 257     status_words = splitWs (text status)
 258
 259
 260 -- | Get all referenced users' timeline URLs.
 261 --
 262 make_user_timeline_urls :: Status -> [String]
 263 make_user_timeline_urls status =
 264   map screen_name_to_timeline_url usernames
 265   where
 266     usernames = parse_usernames_from_status status
 267
 268
 269 status_tests :: TestTree
 270 status_tests =
 271   testGroup "Status Tests" [ test_parse_usernames ]
 272
 273
 274 test_parse_usernames :: TestTree
 275 test_parse_usernames =
 276   testCase description $ actual @?= expected
 277   where
 278     description = "all usernames are parsed"
 279
 280     dummy_user = User { screen_name = "nobody" }
 281     dummy_text = "Hypothesis: @donsbot and @bonus500 are two " ++
 282                  "personalities belonging to the same person."
 283     dummy_status = Status { status_id = 1,
 284                             created_at = Nothing,
 285                             text = dummy_text,
 286                             user = dummy_user,
 287                             reply = False,
 288                             retweeted = False
 289                           }
 290
 291     actual = parse_usernames_from_status dummy_status
 292     expected = ["donsbot", "bonus500"]