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 (Show, Eq)
  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_status_time :: String -> Maybe UTCTime
  69 parse_status_time =
  70   parseTime defaultTimeLocale status_format
  71   where
  72     -- | Should match e.g. "Sun Oct 24 18:21:41 +0000 2010"
  73     status_format :: String
  74     status_format = "%a %b %d %H:%M:%S %z %Y"
  75
  76 utc_time_to_rfc822 :: Maybe TimeZone -> UTCTime -> String
  77 utc_time_to_rfc822 mtz utc =
  78   case mtz of
  79     Nothing ->  foo utc
  80     Just tz -> foo $ utcToZonedTime tz utc
  81   where
  82     foo = formatTime defaultTimeLocale rfc822DateFormat
  83
  84
  85 show_created_at :: Maybe TimeZone -> Status -> String
  86 show_created_at mtz =
  87   (maybe "" (utc_time_to_rfc822 mtz)) . created_at
  88
  89 -- | Returns a nicely-formatted String representing the given 'Status'
  90 --   object.
  91 --
  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 --
 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 --
 123 parse_username :: String -> Maybe String
 124 parse_username word =
 125   case matches of
 126     Nothing -> Nothing
 127     Just [] -> Nothing
 128     Just (first_match:_) -> Just first_match
 129   where
 130     username_regex = mkRegex "@([a-zA-Z0-9_]+)"
 131     matches = matchRegex username_regex word
 132
 133
 134 -- | Parse all usernames of the form \@username from a status.
 135 --
 136 parse_usernames_from_status :: Status -> [String]
 137 parse_usernames_from_status status =
 138   mapMaybe parse_username status_words
 139   where
 140     status_words = splitWs (text status)
 141
 142
 143 -- | Get all referenced users' timeline URLs.
 144 --
 145 make_user_timeline_urls :: Status -> [String]
 146 make_user_timeline_urls status =
 147   map screen_name_to_timeline_url usernames
 148   where
 149     usernames = parse_usernames_from_status status
 150
 151
 152 status_tests :: TestTree
 153 status_tests =
 154   testGroup "Status Tests" [ test_parse_usernames ]
 155
 156
 157 test_parse_usernames :: TestTree
 158 test_parse_usernames =
 159   testCase description $ actual @?= expected
 160   where
 161     description = "all usernames are parsed"
 162
 163     dummy_user = User { screen_name = "nobody" }
 164     dummy_text = "Hypothesis: @donsbot and @bonus500 are two " ++
 165                  "personalities belonging to the same person."
 166     dummy_status = Status { status_id = 1,
 167                             created_at = Nothing,
 168                             text = dummy_text,
 169                             user = dummy_user,
 170                             reply = False,
 171                             retweeted = False
 172                           }
 173
 174     actual = parse_usernames_from_status dummy_status
 175     expected = ["donsbot", "bonus500"]