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