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