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