Rewrite everything to use the JSON API with OAuth authentication.
authorMichael Orlitzky <michael@orlitzky.com>
Thu, 4 Jul 2013 00:31:06 +0000 (20:31 -0400)
committerMichael Orlitzky <michael@orlitzky.com>
Thu, 4 Jul 2013 00:31:06 +0000 (20:31 -0400)
src/Mail.hs
src/Main.hs
src/StringUtils.hs
src/Twitter/Http.hs
src/Twitter/Status.hs
src/Twitter/User.hs
src/Twitter/Xml.hs [deleted file]
twat.cabal

index c54255a56a26a1e620a0f53f0d7386545ed55161..e1884afb9daf0c9fa2df33b67b30e81f82ab79a9 100644 (file)
@@ -15,7 +15,7 @@ import System.IO (hClose, hGetContents, hPutStr)
 
 type Header = String
 
--- |A crude model of an RFC821 email message.
+-- | A crude model of an RFC821 email message.
 data Message = Message { headers :: [Header],
                          subject :: String,
                          body    :: String,
@@ -23,35 +23,39 @@ data Message = Message { headers :: [Header],
                          to      :: String }
              deriving (Eq)
 
--- |The default headers attached to each message.
--- The MIME junk is needed for UTF-8 to work properly.
--- Note that your mail server should support the 8BITMIME extension.
+-- | The default headers attached to each message.  The MIME junk is
+--   needed for UTF-8 to work properly. Note that your mail server
+--   should support the 8BITMIME extension.
 default_headers :: [Header]
 default_headers = ["MIME-Version: 1.0",
                    "Content-Type: text/plain; charset=UTF-8",
                    "Content-Transfer-Encoding: 8bit"]
 
--- |Showing a message will print it in roughly RFC-compliant
--- form. This form is sufficient for handing the message off to
--- sendmail (or compatible).
+-- | Showing a message will print it in roughly RFC-compliant
+--   form. This form is sufficient for handing the message off to
+--   sendmail (or compatible).
 instance Show Message where
-    show m =
-        concat [ if (length (headers m) == 0) then "" else (intercalate "\n" (headers m)) ++ "\n",
-                 "Subject: " ++ (subject m) ++ "\n",
-                 "From: " ++ (from m) ++ "\n",
-                 "To: " ++ (to m) ++ "\n",
-                 "\n",
-                 (body m) ]
-
+  show m =
+    concat [ formatted_headers,
+             "Subject: " ++ (subject m) ++ "\n",
+             "From: " ++ (from m) ++ "\n",
+             "To: " ++ (to m) ++ "\n",
+             "\n",
+             (body m) ]
+    where
+      formatted_headers =
+        if (length (headers m) == 0)
+        then ""
+        else (intercalate "\n" (headers m)) ++ "\n"
 
 
 -- |Pad a string on the left with zeros until the entire string has
 -- length n.
 pad_left :: String -> Int -> String
 pad_left str n
        | n < (length str) = str
        | otherwise = (replicate num_zeros '0') ++ str
-    where num_zeros = n - (length str)
+ | n < (length str) = str
+ | otherwise = (replicate num_zeros '0') ++ str
+   where num_zeros = n - (length str)
 
 
 
@@ -97,8 +101,8 @@ sendmail sendmail_path message = do
 -- three-tuples.
 print_sendmail_result :: (String, String, ExitCode) -> IO ()
 print_sendmail_result (outs, errs, ec) = do
-    case ec of
-      ExitSuccess -> return ()
-      _ -> putStrLn $ concat ["Output: " ++ outs,
-                              "\nErrors: " ++ errs,
-                              "\nExit Code: " ++ (show ec)]
+  case ec of
+    ExitSuccess -> return ()
+    _ -> putStrLn $ concat ["Output: " ++ outs,
+                            "\nErrors: " ++ errs,
+                            "\nExit Code: " ++ (show ec)]
index a52a73fa51d37215255d2a2b17aec5e56737d1ea..bf99fe853fd2e947a5e1508cb8eeb9ddf92d835f 100644 (file)
@@ -3,7 +3,9 @@ where
 
 import Control.Concurrent (forkIO, threadDelay)
 import Control.Monad (forever, when)
+import Data.Aeson (decode)
 import Data.List ((\\))
+import Data.Time.LocalTime (TimeZone, getCurrentTimeZone)
 import System.Exit (ExitCode(..), exitWith)
 import System.IO (hPutStrLn, stderr)
 
@@ -16,38 +18,37 @@ import Twitter.Status
 import Twitter.User
 
 
--- |A wrapper around threadDelay which takes seconds instead of
--- microseconds as its argument.
+-- | A wrapper around threadDelay which takes seconds instead of
+--   microseconds as its argument.
 thread_sleep :: Int -> IO ()
 thread_sleep seconds = do
   let microseconds = seconds * (10 ^ (6 :: Int))
   threadDelay microseconds
 
 
--- |Given a 'Message', 'Status', and default date, update that
--- message's body and subject with the information contained in the
--- status. Adds a /Date: / header, and returns the updated message.
-message_from_status :: Message -> String -> Status -> Message
-message_from_status message default_date status =
+-- | Given a 'Message', 'Status', and date, update that message's body
+-- and subject with the information contained in the status. Adds a
+-- /Date: / header, and returns the updated message.
+message_from_status :: Maybe TimeZone -> Message -> String -> Status -> Message
+message_from_status mtz message default_date status =
   message { subject = "Twat: " ++ (screen_name (user status)),
-            body    = (pretty_print status),
+            body    = (pretty_print mtz status),
             headers = ((headers message) ++ ["Date: " ++ date])}
   where
-    -- Use the Status' created_at date if it can be coerced into
-    -- RFC822 format.
-    date = case (created_at_to_rfc822 $ created_at status) of
-             Nothing -> default_date
-             Just c  -> c
+    date =
+      case created_at status of
+        Nothing -> default_date
+        Just c  -> utc_time_to_rfc822 mtz c
 
 -- | If the given Message is not Nothing, send a copy of it for every
 -- Status in the list.
-send_messages :: Cfg -> Maybe Message -> [Status] -> IO ()
-send_messages cfg maybe_message statuses =
+send_messages :: Cfg -> Maybe TimeZone -> Maybe Message -> [Status] -> IO ()
+send_messages cfg mtz maybe_message statuses =
   case maybe_message of
     Nothing -> return ()
     Just message -> do
       default_date <- rfc822_now
-      let mfs = message_from_status message (default_date)
+      let mfs = message_from_status mtz message default_date
       let messages = map mfs statuses
       sendmail_results <- mapM sendmail' messages
       _ <- mapM print_sendmail_result sendmail_results
@@ -69,7 +70,7 @@ mention_replies cfg ss = do
 --   and verbose is enabled.
 mention_retweets :: Cfg -> [Status] -> IO ()
 mention_retweets cfg ss = do
-  let retweets = filter retweet ss
+  let retweets = filter retweeted ss
   when ((ignore_retweets cfg) && (verbose cfg)) $ do
     let countstr = show $ length retweets
     putStrLn  $ "Ignoring " ++ countstr ++ " retweets."
@@ -82,7 +83,7 @@ filter_statuses cfg ss =
   good_statuses
   where
   replies  = filter reply ss
-  retweets = filter retweet ss
+  retweets = filter retweeted ss
 
   good_statuses' = case (ignore_replies cfg) of
                          True  -> ss \\ replies
@@ -103,13 +104,10 @@ filter_statuses cfg ss =
 recurse :: Cfg -> String -> Integer -> (Maybe Message) -> IO ()
 recurse cfg username latest_status_id maybe_message = do
   thread_sleep (heartbeat cfg)
-  xmldata <- get_user_new_statuses username latest_status_id
+  timeline <- get_user_new_statuses username latest_status_id
 
-  -- Parsing an empty result can blow up. Just pretend there are
-  -- no new statuses in that case.
-  let new_statuses = case xmldata of
-                       Just xml -> parse_statuses xml
-                       Nothing  -> []
+  -- FIXME
+  let Just new_statuses = decode timeline :: Maybe Timeline
 
   case (length new_statuses) of
     0 ->
@@ -121,9 +119,11 @@ recurse cfg username latest_status_id maybe_message = do
 
       let good_statuses = filter_statuses cfg new_statuses
 
-      _ <- mapM (putStrLn . pretty_print) good_statuses
+      tz <- getCurrentTimeZone
+      let mtz = Just tz
+      mapM_ (putStrLn . (pretty_print mtz)) good_statuses
 
-      send_messages cfg maybe_message good_statuses
+      send_messages cfg mtz maybe_message good_statuses
 
       let new_latest_status_id = get_max_status_id new_statuses
       do_recurse new_latest_status_id
@@ -139,19 +139,16 @@ recurse cfg username latest_status_id maybe_message = do
 --   latest status id to be posted once we have done so.
 get_latest_status_id :: Int -> String -> IO Integer
 get_latest_status_id delay username = do
-  xmldata <- get_user_timeline username
+  timeline <- get_user_timeline username
+  let Just initial_timeline = decode timeline :: Maybe Timeline
 
-  let initial_statuses = case xmldata of
-                           Just xml -> parse_statuses xml
-                           Nothing -> []
-
-  case (length initial_statuses) of
+  case (length initial_timeline) of
     0 -> do
       -- If the HTTP part barfs, try again after a while.
       putStrLn ("Couldn't retrieve " ++ username ++ "'s timeline. Retrying...")
       thread_sleep delay
       get_latest_status_id delay username
-    _ -> return (get_max_status_id initial_statuses)
+    _ -> return (get_max_status_id initial_timeline)
 
 
 
@@ -224,36 +221,3 @@ main = do
     thread_sleep (heartbeat cfg)
 
   return ()
-
-
--- | A debugging tool that will parse, print, and email a single
---   status (given by its id).
-twat_single_status :: Cfg -> Integer -> (Maybe Message) -> IO ()
-twat_single_status cfg the_status_id maybe_message = do
-    xmldata <- get_status the_status_id
-
-    -- Parsing an empty result can blow up. Just pretend there are
-    -- no new statuses in that case.
-    let statuses = case xmldata of
-                     Just xml -> parse_status xml
-                     Nothing  -> []
-
-    case (length statuses) of
-      0 -> do
-        putStrLn "No statuses returned."
-        return ()
-      _ -> do
-        _ <- mapM (putStrLn . pretty_print) statuses
-
-        case maybe_message of
-          Nothing -> do
-             putStrLn "No message object given."
-             return ()
-          Just message -> do
-             default_date <- rfc822_now
-             let messages = map (message_from_status message (default_date)) statuses
-             sendmail_results <- mapM sendmail' messages
-             _ <- mapM print_sendmail_result sendmail_results
-             return ()
-    where
-      sendmail' = sendmail (sendmail_path cfg)
\ No newline at end of file
index b7d291c229acdc96f777f8b60078fbd991d3c0cd..f9d7dfc9cf8ae4b08c05f8f9dbd21ec52fac1230 100644 (file)
@@ -5,11 +5,13 @@ where
 import Test.HUnit
 
 
--- |Takes a list of strings, call them string1, string2, etc. and
--- numbers them like a list. So,
--- 1. string1
--- 2. string2
--- 3. etc.
+-- | Takes a list of strings, call them string1, string2, etc. and
+--   numbers them like a list. So,
+--
+--   1. string1
+--   2. string2
+--   3. etc.
+--
 listify :: [String] -> [String]
 listify items =
     zipWith (++) list_numbers items
index 4c7c6086d9cad0fc22939f4612ed2acddf1d0978..112c2ea2fa293f75aa16382ab7770b07c9607c2f 100644 (file)
@@ -1,92 +1,98 @@
 module Twitter.Http
 where
 
-import Network.Curl
-import System.IO (hPutStrLn, stderr)
+import qualified Data.ByteString.Lazy as B
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.Conduit as C
+import Data.Conduit.Binary (sinkLbs)
+import Network.HTTP.Conduit
+import Web.Authenticate.OAuth (
+  OAuth(..),
+  Credential,
+  newCredential,
+  newOAuth,
+  signOAuth)
 
 -- |The API URL of username's timeline.
 --
 -- See,
 --
---   <http://dev.twitter.com/doc/get/statuses/user_timeline>
+--   <https://dev.twitter.com/docs/api/1.1/get/statuses/user_timeline>
 --
 user_timeline_url :: String -> String
 user_timeline_url username =
-    concat [ "http://api.twitter.com/1/statuses/user_timeline.xml",
-             "?screen_name=" ++ username,
-             "&include_rts=true",
-             "&count=10" ]
+  concat [ "https://api.twitter.com/",
+           "1.1/",
+           "statuses/",
+           "user_timeline.json?",
+           "screen_name=",
+           username,
+           "&include_rts=true&",
+           "count=10" ]
 
 status_url :: Integer -> String
 status_url status_id =
-    concat [ "http://api.twitter.com/1/statuses/show/",
-             (show status_id),
-             ".xml" ]
-
--- |Given username's last status id, constructs the API URL for
--- username's new statuses. Essentially, 'user_timeline_url' with a
--- "since_id" parameter tacked on.
+  concat [ "https://api.twitter.com/",
+           "1.1/",
+           "statuses/",
+           "show.json?id=",
+           (show status_id) ]
+
+-- | Given username's last status id, constructs the API URL for
+--   username's new statuses. Essentially, 'user_timeline_url' with a
+--   "since_id" parameter tacked on.
 user_new_statuses_url :: String -> Integer -> String
 user_new_statuses_url username last_status_id =
-    concat [ user_timeline_url username,
-             "&since_id=" ++ (show last_status_id) ]
+  concat [ user_timeline_url username,
+           "&since_id=" ++ (show last_status_id) ]
 
 
-get_status :: Integer -> IO (Maybe String)
+get_status :: Integer -> IO B.ByteString
 get_status status_id = do
-    let uri = (status_url status_id)
-    status <- (http_get uri)
-    return status
+  let uri = (status_url status_id)
+  status <- (http_get uri)
+  return status
 
 
--- |Return's username's timeline, or 'Nothing' if there was an error.
-get_user_timeline :: String -> IO (Maybe String)
+-- | Return's username's timeline.
+get_user_timeline :: String -> IO B.ByteString
 get_user_timeline username = do
   let uri = (user_timeline_url username)
   timeline <- (http_get uri)
   return timeline
 
 
--- | Returns the XML representing all of username's statuses that are
+-- | Returns the JSON representing all of username's statuses that are
 --   newer than last_status_id.
-get_user_new_statuses :: String -> Integer -> IO (Maybe String)
+get_user_new_statuses :: String -> Integer -> IO B.ByteString
 get_user_new_statuses username last_status_id = do
   let uri = (user_new_statuses_url username last_status_id)
   new_statuses <- (http_get uri)
   return new_statuses
 
 
--- | Options that will be passed to every curl request.
-curl_options :: [CurlOption]
-curl_options =
-  [ CurlTimeout 45,
-    -- The Global cache is not thread-friendly.
-    CurlDNSUseGlobalCache False,
-     -- And we don't want to use a DNS cache anyway.
-    CurlDNSCacheTimeout 0 ]
-
-
--- | Uses the CURL API to retrieve uri. Returns 'Nothing' if there was
---   an error.
-http_get :: String -> IO (Maybe String)
-http_get uri =
-  withCurlDo $ do
-  -- Create a Curl instance.
-  curl <- initialize
-
-  -- Perform the request, and get back a CurlResponse object.
-  -- The cast is needed to specify how we would like our headers
-  -- and body returned (Strings).
-  resp <- do_curl_ curl uri curl_options :: IO CurlResponse
-
-  -- Pull out the response code as a CurlCode.
-  let code = respCurlCode resp
-
-  case code of
-    CurlOK -> return $ Just (respBody resp)
-    error_code -> do
-      hPutStrLn stderr ("HTTP Error: " ++ (show error_code))
-      -- If an error occurred, we want to dump as much information as
-      -- possible. If this becomes a problem, we can use respGetInfo to
-      -- query the response object for more information
-      return Nothing
+-- | Retrieve a URL, or crash.
+http_get :: String -> IO B.ByteString
+http_get url = do
+  manager <- newManager def
+  request <- parseUrl url
+
+  C.runResourceT $ do
+    signed_request <- signOAuth oauth credential request
+    response <- http signed_request manager
+    responseBody response C.$$+- sinkLbs
+
+  where
+    consumer_key = BC.pack ""
+    consumer_secret = BC.pack ""
+    access_token = BC.pack ""
+    access_secret = BC.pack ""
+
+    oauth :: OAuth
+    oauth = newOAuth {
+              oauthConsumerKey = consumer_key,
+              oauthConsumerSecret = consumer_secret
+            }
+
+    credential :: Credential
+    credential = newCredential access_token access_secret
index 3414d7c926d57a32eabd96096d35d342c53f76e8..ef4e1037b9ca54b212f5666d60271ff832468301 100644 (file)
--- |Functions and data for working with Twitter statuses.
+-- | Functions and data for working with Twitter statuses.
 module Twitter.Status
 where
 
-import Data.Maybe
+import Control.Applicative ((<$>), (<*>))
+import Control.Monad (liftM)
+import Data.Aeson ((.:), FromJSON(..), Value(Object))
+import Data.Maybe (catMaybes, isJust)
+import Data.Monoid (mempty)
 import Data.String.Utils (join, splitWs)
-import Data.Time (ZonedTime, formatTime, readsTime)
+import Data.Text (pack)
+import Data.Time (formatTime)
+import Data.Time.Clock (UTCTime)
+import Data.Time.Format (parseTime)
+import Data.Time.LocalTime (TimeZone, utcToZonedTime)
 import System.Locale (defaultTimeLocale, rfc822DateFormat)
 import Test.HUnit
 import Text.Regex (matchRegex, mkRegex)
-import Text.XML.HaXml
-import Text.XML.HaXml.Posn (noPos)
 
 import StringUtils (listify)
 import Twitter.User
-import Twitter.Xml
-
--- |Represents one Twitter status. We don't care about any of their
--- other properties.
-data Status = Status { status_id  :: Integer,
-                       created_at :: String,
-                       text       :: String,
-                       user       :: User,
-                       reply      :: Bool,
-                       retweet    :: Bool }
-            deriving (Show, Eq)
-
-
--- |Given some XML content, create a 'Status' from it.
-status_from_content :: Content i -> Maybe Status
-status_from_content content =
-    if (length status_ids) == 0
-        || (length created_ats) == 0
-        || (length texts) == 0
-        || (length users) == 0
-        || (length retweeteds) == 0
-    then
-        Nothing
-    else do
-      first_status_id <- get_char_data (status_ids !! 0)
-      integer_status_id <- parse_status_id first_status_id
-      first_created_at <- get_char_data (created_ats !! 0)
-      first_user <- user_from_content (users !! 0)
-      first_retweeted <- get_char_data (retweeteds !! 0)
-
-      let is_reply = case (length reply_to_status_ids) of
-                       0 -> False
-                       _ -> True
-
-      let is_retweet = case first_retweeted of
-                         "true" -> True
-                         _      -> False
-
-      return (Status
-               integer_status_id
-               first_created_at
-               all_text
-               first_user
-               is_reply
-               is_retweet)
-    where
-      status_ids = (unique_id content)
-      created_ats = (status_created_at content)
-      texts = (status_text content)
-      users = (status_user content)
-      retweeteds = (status_retweeted content)
-      reply_to_status_ids = (status_reply_to_status_id content)
-
-      all_text = concat $ catMaybes (map get_char_data texts)
-
-      parse_status_id :: String -> Maybe Integer
-      parse_status_id s =
-        case (reads s) of
-          [] -> Nothing
-          parseresult:_ -> Just (fst parseresult)
-
--- |Takes an XML String as an argument, and returns the
--- status that was parsed from it. Should only be used
--- on XML string where a <status> is a top-level element.
-parse_status :: String -> [Status]
-parse_status xml_data =
-    catMaybes maybe_status
-    where
-      (Document _ _ root _) = xmlParse xml_file_name xml_data
-      root_elem = CElem root noPos
-      status_element = (single_status root_elem)
-      maybe_status = map status_from_content status_element
 
-
--- |Takes an XML String as an argument, and returns the list of
--- statuses that can be parsed from it.
-parse_statuses :: String -> [Status]
-parse_statuses xml_data =
-    catMaybes maybe_statuses
+data Status = Status {
+  created_at :: Maybe UTCTime,
+  status_id   :: Integer,
+  reply :: Bool,
+  retweeted :: Bool,
+  text :: String,
+  user :: User
+  } deriving (Show, Eq)
+
+type Timeline = [Status]
+
+instance FromJSON Status where
+  parseJSON (Object t) =
+    Status <$>
+      liftM parse_status_time (t .: created_at_field) <*>
+      (t .: id_field) <*>
+      liftM isJustInt (t .: in_reply_to_status_id_field) <*>
+      (t .: retweeted_field) <*>
+      (t .: text_field) <*>
+      (t .: user_field)
     where
-      (Document _ _ root _) = xmlParse xml_file_name xml_data
-      root_elem = CElem root noPos
-      status_elements = (all_statuses root_elem)
-      maybe_statuses = map status_from_content status_elements
-
-
--- |This is a required parameter to the xmlParse function used in
--- error reporting. We're not parsing a function, though, so we leave
--- it blank.
-xml_file_name :: String
-xml_file_name = ""
+      -- The typechecker flips out without this.
+      isJustInt :: Maybe Int -> Bool
+      isJustInt = isJust
+
+      created_at_field = pack "created_at"
+      id_field = pack "id"
+      in_reply_to_status_id_field = pack "in_reply_to_status_id"
+      retweeted_field = pack "retweeted"
+      text_field = pack "text"
+      user_field = pack "user"
+
+  -- Do whatever.
+  parseJSON _ = mempty
+
+parse_status_time :: String -> Maybe UTCTime
+parse_status_time =
+  parseTime defaultTimeLocale status_format
+  where
+    -- | Should match e.g. "Sun Oct 24 18:21:41 +0000 2010"
+    status_format :: String
+    status_format = "%a %b %d %H:%M:%S %z %Y"
+
+utc_time_to_rfc822 :: Maybe TimeZone -> UTCTime -> String
+utc_time_to_rfc822 mtz utc =
+  case mtz of
+    Nothing ->  foo utc
+    Just tz -> foo $ utcToZonedTime tz utc
+  where
+    foo = formatTime defaultTimeLocale rfc822DateFormat
+
+
+show_created_at :: Maybe TimeZone -> Status -> String
+show_created_at mtz =
+  (maybe "" id) . (fmap $ utc_time_to_rfc822 mtz) . created_at
+
+-- | Returns a nicely-formatted String representing the given 'Status'
+--   object.
+pretty_print :: Maybe TimeZone -> Status -> String
+pretty_print mtz status =
+  concat [ name,
+           " - ",
+           sca,
+           "\n",
+           replicate bar_length '-',
+           "\n",
+           text status,
+           "\n\n",
+           join "\n" user_timeline_urls,
+           "\n" ]
+  where
+    sca = show_created_at mtz status
+    name = screen_name (user status)
+    user_timeline_urls = listify (make_user_timeline_urls status)
+    bar_length = (length name) + 3 + (length sca)
 
 
-created_at_to_rfc822 :: String -> Maybe String
-created_at_to_rfc822 s =
-  case reads_result of
-    [(t,_)] ->
-      Just $ formatTime defaultTimeLocale rfc822DateFormat t
-    _       -> Nothing
-  where
-    -- Should match e.g. "Sun Oct 24 18:21:41 +0000 2010"
-    fmt :: String
-    fmt = "%a %b %d %H:%M:%S %z %Y"
-
-    reads_result :: [(ZonedTime, String)]
-    reads_result = readsTime defaultTimeLocale fmt s
-
--- |Returns a nicely-formatted String representing the given 'Status'
--- object.
-pretty_print :: Status -> String
-pretty_print status =
-    concat [ name,
-             " - ",
-             (created_at status),
-             "\n",
-             replicate ((length name) + 3 + (length (created_at status))) '-',
-             "\n",
-             replace_entities (text status),
-             "\n\n",
-             join "\n" user_timeline_urls,
-             "\n" ]
-             where
-               name = screen_name (user status)
-               user_timeline_urls = listify (make_user_timeline_urls status)
-
-
--- |Given a list of statuses, returns the greatest status_id belonging
--- to one of the statuses in the list.
-get_max_status_id :: [Status] -> Integer
+-- | Given a list of statuses, returns the greatest status_id
+--   belonging to one of the statuses in the list.
+get_max_status_id :: Timeline -> Integer
 get_max_status_id statuses =
   maximum status_ids
   where
     status_ids = map status_id statuses
 
 
--- |Parse one username from a word.
+-- | Parse one username from a word.
 parse_username :: String -> Maybe String
 parse_username word =
-    case matches of
-      Nothing -> Nothing
-      Just [] -> Nothing
-      Just (first_match:_) -> Just first_match
-    where
-      username_regex = mkRegex "@([a-zA-Z0-9_]+)"
-      matches = matchRegex username_regex word
+  case matches of
+    Nothing -> Nothing
+    Just [] -> Nothing
+    Just (first_match:_) -> Just first_match
+  where
+    username_regex = mkRegex "@([a-zA-Z0-9_]+)"
+    matches = matchRegex username_regex word
 
 
--- |Parse all usernames of the form \@username from a status.
+-- | Parse all usernames of the form \@username from a status.
 parse_usernames_from_status :: Status -> [String]
 parse_usernames_from_status status =
-    catMaybes (map parse_username status_words)
-    where
-      status_words = splitWs (text status)
+  catMaybes (map parse_username status_words)
+  where
+    status_words = splitWs (text status)
 
--- |Get all referenced users' timeline URLs.
+-- | Get all referenced users' timeline URLs.
 make_user_timeline_urls :: Status -> [String]
 make_user_timeline_urls status =
-    map screen_name_to_timeline_url usernames
-    where
-      usernames = parse_usernames_from_status status
+  map screen_name_to_timeline_url usernames
+  where
+    usernames = parse_usernames_from_status status
 
 
 status_tests :: [Test]
@@ -189,11 +147,11 @@ test_parse_usernames =
     where
       dummy_user = User { screen_name = "nobody" }
       dummy_status = Status { status_id = 1,
-                              created_at = "never",
+                              created_at = Nothing,
                               text = "Hypothesis: @donsbot and @bonus500 are two personalities belonging to the same person.",
                               user = dummy_user,
                               reply = False,
-                              retweet = False
+                              retweeted = False
                             }
 
       actual_usernames = parse_usernames_from_status dummy_status
index 2c199c9d3607d0b3187babaf20c5a3ef44669a08..a1eed3a356dd5922349d02aa29ad71d3e94a51b3 100644 (file)
@@ -2,32 +2,25 @@
 module Twitter.User
 where
 
-import Text.XML.HaXml
-
-import Twitter.Xml
-
--- |Represents a Twitter user, and contains the only attribute thereof
--- that we care about: the screen (user) name.
-data User = User { screen_name :: String }
-          deriving (Show, Eq)
-
-
--- |Create a 'User' from HaXML 'Content'.
-user_from_content :: Content i -> (Maybe User)
-user_from_content c =
-    if (length names) == 0
-    then
-        Nothing
-    else
-        case (get_char_data (names !! 0)) of
-          Nothing -> Nothing
-          (Just content) -> Just (User (content))
-
+import Control.Applicative ((<$>))
+import Data.Aeson ((.:), FromJSON(..), Value(Object))
+import Data.Text (pack)
+import Data.Monoid (mempty)
+
+-- | Represents a Twitter user, and contains the only attribute
+--   thereof that we care about: the screen (user) name.
+data User = User { screen_name :: String } deriving (Eq, Show)
+
+instance FromJSON User where
+  parseJSON (Object u) =
+    User <$> (u .: screen_name_field)
     where
-    names = user_screen_name c
+      screen_name_field = pack "screen_name"
 
+  -- Do whatever.
+  parseJSON _ = mempty
 
 -- |Get the URL for the given screen name's timeline.
 screen_name_to_timeline_url :: String -> String
-screen_name_to_timeline_url sn =
-    "http://twitter.com/" ++ sn
+screen_name_to_timeline_url =
+  ("http://twitter.com/" ++)
diff --git a/src/Twitter/Xml.hs b/src/Twitter/Xml.hs
deleted file mode 100644 (file)
index 871d216..0000000
+++ /dev/null
@@ -1,154 +0,0 @@
--- |Application-specific XML functions.
-module Twitter.Xml
-where
-
-import Data.Char (chr)
-import Test.HUnit
-import Text.Regex (matchRegex, mkRegex, subRegex)
-import Text.XML.HaXml
-
--- |Returns the 'CharData' contained within the given 'Content', or
--- 'Nothing' if no acceptable CharData was found. It will parse either
--- a 'CString' ('String') or 'CRef' (XML entity reference).
-get_char_data :: Content i -> (Maybe CharData)
-get_char_data (CString _ cd _) = Just cd
-get_char_data (CRef ref _) = Just (verbatim ref) -- Entities.
-get_char_data _ = Nothing
-
-
--- |A 'CFilter' returning all top-level <status> elements.
--- The name is due to the fact that if we retrieve more than
--- one status, they will be wrapped in a <statuses> tag, and
--- thus not be top-level.
-single_status :: CFilter i
-single_status = (tag "status")
-
--- |A 'CFilter' returning all <status> tags within <statuses>.
-all_statuses :: CFilter i
-all_statuses = (tag "statuses" /> tag "status")
-
--- |Finds the text of the <id> element contained within some other
--- content. Called unique_id here because status_id is used elsewhere.
-unique_id :: CFilter i
-unique_id = keep /> (tag "id") /> txt
-
--- |Finds the text of the <created_at> element contained within some
--- other element.
-status_created_at :: CFilter i
-status_created_at = keep /> (tag "created_at") /> txt
-
--- |Finds the text of the <text> element contained within some
--- other element.
-status_text :: CFilter i
-status_text = keep /> (tag "text") /> txt
-
--- |Finds the XML of the <user> element contained within some other
--- element.
-status_user :: CFilter i
-status_user = keep /> (tag "user")
-
--- | Finds the text of the <retweeted> element contained within some
---   other element.
-status_retweeted :: CFilter i
-status_retweeted = keep /> (tag "retweeted") /> txt
-
--- | Finds the text of the <in_reply_to_status_id> element contained
---   within some other element.
-status_reply_to_status_id :: CFilter i
-status_reply_to_status_id = keep /> (tag "in_reply_to_status_id") /> txt
-
--- |Finds the text of the <screen_name> element contained within some
--- other element.
-user_screen_name :: CFilter i
-user_screen_name = keep /> (tag "screen_name") /> txt
-
--- |A wrapper around the 'read' function which returns either Nothing
--- or (Just <the thing that could be read>).
-maybe_read :: (Read a) => String -> Maybe a
-maybe_read str =
-    case (reads str) of
-      [] -> Nothing
-      ((y,_):_) -> Just y
-
--- |Takes a unicode codepoint in decimal and returns it as a
--- one-character string.
-entity_from_codepoint :: String -> String
-entity_from_codepoint codepoint =
-    case (maybe_read codepoint) of
-      Nothing  -> ""
-      Just num -> [(chr num)]
-
-
--- | A list of tuples whose first entry is a regular expression
---   matching XML entities, and whose second entry is the ASCII
---   character represented by that entity.
---
---   For some reason, ampersands are escaped twice in the status
---   text. Rather than unescape everything twice, we just stick "amp"
---   in the list again.
-xml_entities :: [(String, String)]
-xml_entities = [("[lr]dquo", "\""),
-                ("quot",     "\""),
-                ("[mn]dash", "-"),
-                ("nbsp",     " "),
-                ("amp",      "&"),
-                ("amp",      "&"),
-                ("lt",       "<"),
-                ("gt",       ">"),
-                ("hellip",   "…")]
-
--- |Replace all of the XML entities in target.
-replace_entities :: String -> String
-replace_entities target =
-    unescape_numeric (unescape_recursive xml_entities target)
-
--- |Recursively unescape all numeric entities in the given String.
-unescape_numeric :: String -> String
-unescape_numeric target =
-    case match of
-      Nothing -> target
-      Just subexprs ->
-          case subexprs of
-            []   -> target
-            s1:_ ->
-                let this_entity_regex = mkRegex ("&#" ++ s1 ++ ";") in
-                let replacement = entity_from_codepoint s1 in
-                let new_target = subRegex this_entity_regex target replacement in
-                unescape_numeric new_target
-    where
-      from = "&#([0-9]+);"
-      match = matchRegex (mkRegex from) target
-
-
-
--- |The recursive function which does the real work for
--- 'replace_entities'.
-unescape_recursive :: [(String, String)] -> String -> String
-unescape_recursive [] target = target
-unescape_recursive replacements target =
-    unescape_recursive (tail replacements) (subRegex (mkRegex from) target to)
-    where
-      replacement = (replacements !! 0)
-      from = "&" ++ (fst replacement) ++ ";"
-      to = (snd replacement)
-
-
-
-xml_tests :: [Test]
-xml_tests = [ test_replace_entities, test_double_unescape ]
-
-
-test_replace_entities :: Test
-test_replace_entities =
-    TestCase $ assertEqual "All entities are replaced correctly." expected_text actual_text
-    where
-      actual_text = (replace_entities "&quot;The moon is gay&#8230;&hellip;&quot; said &lt;insert the current president of the United States of America&gt;. &ldquo;It&#8217;s OK&mdash;&ndash;he&#8217;s not a real doctor.&rdquo;")
-      expected_text = "\"The moon is gay……\" said <insert the current president of the United States of America>. \"It’s OK--he’s not a real doctor.\""
-
-
-test_double_unescape :: Test
-test_double_unescape =
-    TestCase $ assertEqual "The status text is unescaped twice." expected_text actual_text
-    where
-      actual_text = (replace_entities "As a kid, I'd pull a girl's hair to let her know I liked her, but now that I'm older &amp;amp; wiser I simply hit her with my car.")
-      expected_text = "As a kid, I'd pull a girl's hair to let her know I liked her, but now that I'm older & wiser I simply hit her with my car."
index 6d968deaae55c0490080e3da3e1ffff760f6592c..8a11081d0377b7edbf30d96386d524ed5475de08 100644 (file)
@@ -9,15 +9,20 @@ build-type:     Simple
 
 executable twat
   build-depends:
+    aeson                       == 0.6.*,
+    authenticate-oauth          == 1.4.*,
     base                        == 4.*,
-    curl                        == 1.3.*,
-    directory                   == 1.1.*,
-    HaXml                       == 1.23.*,
+    bytestring                  == 0.10.*,
+    conduit                     == 1.*,
+    directory                   == 1.2.*,
+    HaXml                       == 1.24.*,
+    http-conduit                == 1.9.*,
     HUnit                       == 1.2.*,
     MissingH                    == 1.*,
     process                     == 1.*,
     old-locale                  == 1.*,
     regex-compat                == 0.*,
+    text                        == 0.11.*,
     time                        == 1.*