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.Tasty ( TestTree, testGroup )
  26 import Test.Tasty.HUnit ( (@?=), testCase )
  27 import Text.Regex ( matchRegex, mkRegex )
  28
  29 import Html ( replace_entities )
  30 import StringUtils ( listify )
  31 import Twitter.User ( User(..), screen_name_to_timeline_url )
  32
  33 data Status = Status {
  34   created_at :: Maybe UTCTime,
  35   status_id   :: Integer,
  36   reply :: Bool,
  37   retweeted :: Bool,
  38   text :: String,
  39   user :: User }
  40   deriving (Eq, Show)
  41
  42 type Timeline = [Status]
  43
  44 instance FromJSON Status where
  45   parseJSON (Object t) =
  46     Status <$>
  47       liftM parse_status_time (t .: created_at_field) <*>
  48       (t .: id_field) <*>
  49       liftM isJustInt (t .: in_reply_to_status_id_field) <*>
  50       (t .: retweeted_field) <*>
  51       liftM replace_entities (t .: text_field) <*>
  52       (t .: user_field)
  53     where
  54       -- The typechecker flips out without this.
  55       isJustInt :: Maybe Int -> Bool
  56       isJustInt = isJust
  57
  58       created_at_field = pack "created_at"
  59       id_field = pack "id"
  60       in_reply_to_status_id_field = pack "in_reply_to_status_id"
  61       retweeted_field = pack "retweeted"
  62       text_field = pack "text"
  63       user_field = pack "user"
  64
  65   -- Do whatever.
  66   parseJSON _ = mempty
  67
  68 -- | Parse a timestamp from a status into a UTCTime (or Nothing).
  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
  79 -- | Given a 'TimeZone', convert a 'UTCTime' into an RFC822-format
  80 --   time string. If no 'TimeZone' is given, assume UTC.
  81 --
  82 utc_time_to_rfc822 :: Maybe TimeZone -> UTCTime -> String
  83 utc_time_to_rfc822 mtz utc =
  84   case mtz of
  85     Nothing ->  foo utc
  86     Just tz -> foo $ utcToZonedTime tz utc
  87   where
  88     foo = formatTime defaultTimeLocale rfc822DateFormat
  89
  90
  91 -- | Get the 'created_at' time out of a 'Status' and display it as an
  92 --   RFC822-format time string. If there's no created-at time in the
  93 --   status, you'll get an empty string instead.
  94 --
  95 show_created_at :: Maybe TimeZone -> Status -> String
  96 show_created_at mtz =
  97   (maybe "" (utc_time_to_rfc822 mtz)) . created_at
  98
  99
 100 -- | Returns a nicely-formatted String representing the given 'Status'
 101 --   object.
 102 --
 103 pretty_print :: Maybe TimeZone -> Status -> String
 104 pretty_print mtz status =
 105   concat [ name,
 106            " - ",
 107            sca,
 108            "\n",
 109            replicate bar_length '-',
 110            "\n",
 111            text status,
 112            "\n\n",
 113            join "\n" user_timeline_urls,
 114            "\n" ]
 115   where
 116     sca = show_created_at mtz status
 117     name = screen_name (user status)
 118     user_timeline_urls = listify (make_user_timeline_urls status)
 119     bar_length = (length name) + 3 + (length sca)
 120
 121
 122 -- | Given a list of statuses, returns the greatest status_id
 123 --   belonging to one of the statuses in the list.
 124 --
 125 get_max_status_id :: Timeline -> Integer
 126 get_max_status_id statuses =
 127   maximum status_ids
 128   where
 129     status_ids = map status_id statuses
 130
 131
 132 -- | Parse one username from a word.
 133 --
 134 parse_username :: String -> Maybe String
 135 parse_username word =
 136   case matches of
 137     Nothing -> Nothing
 138     Just [] -> Nothing
 139     Just (first_match:_) -> Just first_match
 140   where
 141     username_regex = mkRegex "@([a-zA-Z0-9_]+)"
 142     matches = matchRegex username_regex word
 143
 144
 145 -- | Parse all usernames of the form \@username from a status.
 146 --
 147 parse_usernames_from_status :: Status -> [String]
 148 parse_usernames_from_status status =
 149   mapMaybe parse_username status_words
 150   where
 151     status_words = splitWs (text status)
 152
 153
 154 -- | Get all referenced users' timeline URLs.
 155 --
 156 make_user_timeline_urls :: Status -> [String]
 157 make_user_timeline_urls status =
 158   map screen_name_to_timeline_url usernames
 159   where
 160     usernames = parse_usernames_from_status status
 161
 162
 163 status_tests :: TestTree
 164 status_tests =
 165   testGroup "Status Tests" [ test_parse_usernames ]
 166
 167
 168 test_parse_usernames :: TestTree
 169 test_parse_usernames =
 170   testCase description $ actual @?= expected
 171   where
 172     description = "all usernames are parsed"
 173
 174     dummy_user = User { screen_name = "nobody" }
 175     dummy_text = "Hypothesis: @donsbot and @bonus500 are two " ++
 176                  "personalities belonging to the same person."
 177     dummy_status = Status { status_id = 1,
 178                             created_at = Nothing,
 179                             text = dummy_text,
 180                             user = dummy_user,
 181                             reply = False,
 182                             retweeted = False
 183                           }
 184
 185     actual = parse_usernames_from_status dummy_status
 186     expected = ["donsbot", "bonus500"]