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