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"]