--- The CommandLine module handles parsing of the command-line options.
+-- |The CommandLine module handles parsing of the command-line options.
-- It should more or less be a black box, providing Main with only the
-- information it requires.
-
module CommandLine
( help_set,
help_text,
--- A record containing values for all available options.
+-- |A record containing values for all available options.
data Options = Options { opt_help :: Bool,
opt_from :: Maybe String,
opt_to :: Maybe String }
--- This constructs an instance of Options, with each of its members
--- set to default values.
+-- |Constructs an instance of Options, with each of its members set to
+-- default values.
default_options :: Options
default_options = Options { opt_help = False,
opt_from = Nothing,
opt_to = Nothing }
--- The options list that we construct associates a function with each
+-- |The options list that we construct associates a function with each
-- option. This function is responsible for updating an Options record
-- with the appropriate value.
--
-- For more information and an example of this idiom, see,
--
--- http://www.haskell.org/haskellwiki/High-level_option_handling_with_GetOpt
+-- <http://www.haskell.org/haskellwiki/High-level_option_handling_with_GetOpt>
--
options :: [OptDescr (Options -> IO Options)]
options =
return opts
+-- |Parse errors relating to the list of usernames.
username_errors :: IO [String]
username_errors = do
argv <- getArgs
else return []
+-- |Parse errors relating to the "To" address.
to_errors :: IO [String]
to_errors = do
toaddr <- to_email_address
then return ["\"From\" address specified without \"To\" address."]
else return []
+
+-- |Parse errors relating to the "From" address.
from_errors :: IO [String]
from_errors = do
toaddr <- to_email_address
else return []
+-- |Format an error message for printing.
format_error :: String -> String
format_error err = "ERROR: " ++ err ++ "\n"
--- Return a list of errors.
+-- |Return a list of all parse errors.
parse_errors :: IO [String]
parse_errors = do
argv <- getArgs
errs_from <- from_errors
return $ map format_error (errors ++ errs_username ++ errs_to ++ errs_from)
--- Is the help option set?
+-- |Was the "help" option passed on the command line?
help_set :: IO Bool
help_set = do
opts <- parse_options
return (opt_help opts)
+-- |What "To" address was given on the command line?
to_email_address :: IO (Maybe String)
to_email_address = do
opts <- parse_options
return (opt_to opts)
+-- |What "From" address was given on the command line?
from_email_address :: IO (Maybe String)
from_email_address = do
opts <- parse_options
return (opt_from opts)
+-- |What usernames were passed on the command line?
parse_usernames :: IO [String]
parse_usernames = do
argv <- getArgs
--- |All exit codes that the program can return (excepting ExitSuccess).
--- There's only one, since the program will try/fail forever upon errors.
+-- |All exit codes that the program can return (excepting
+-- ExitSuccess). There's only one, since the program will try and fail
+-- forever upon errors.
module ExitCodes
where
+-- |Email functions and data types.
+
module Mail
where
type Header = String
+-- |A crude model of an RFC821 email message.
data Message = Message { headers :: [Header],
subject :: String,
body :: String,
to :: String }
deriving (Eq)
-instance Show Message where
+-- |Showing a message will print it in roughly RFC-compliant
+-- form. This form is sufficient for handing the message off to
+-- sendmail.
+instance Show Message where
show m =
concat [ if (length (headers m) == 0) then "" else (intercalate "\n" (headers m)) ++ "\n",
"Subject: " ++ (subject m) ++ "\n",
(body m) ]
+-- |Takes a message as an argument, and passes it to the system's
+-- sendmail binary.
sendmail :: Message -> IO (String, String, ExitCode)
sendmail message = do
let sendmail_args = ["-f",
return (outs, errs, ec)
+-- |The 'sendmail' function returns a three-tuple of its outputs,
+-- errors, and exit codes. This function pretty-prints one of those
+-- three-tuples.
print_sendmail_result :: (String, String, ExitCode) -> IO ()
print_sendmail_result (outs, errs, ec) = do
case ec of
import Twitter.User
--- The length of all calls to sleep, in seconds.
+-- |The length of all calls to sleep (or threadDelay), in seconds.
heartbeat :: Int
heartbeat = 600
+-- |A wrapper around threadDelay which takes seconds instead of
+-- microseconds as its argument.
thread_sleep :: Int -> IO ()
-thread_sleep microseconds = do
- let seconds = microseconds * (10 ^ (6 :: Int))
- threadDelay seconds
+thread_sleep seconds = do
+ let microseconds = seconds * (10 ^ (6 :: Int))
+ threadDelay microseconds
+-- |Given a 'Message' and a 'Status', update that message's body and
+-- subject with the information contained in the status. Returns the
+-- updated message.
message_from_status :: Message -> Status -> Message
message_from_status message status =
message { subject = "Twat: " ++ (screen_name (user status)),
body = (pretty_print status) }
+
+-- |This is the main recursive loop. It takes a username, a
+-- latest_status_id, and optionally a 'Message' as arguments. The
+-- latest_status_id is the last status (that we know of) to be posted
+-- to username's Twitter account. If we find any newer statuses when
+-- we check, they are printed and optionally emailed (if a 'Message'
+-- was supplied). Then, the process repeats.
recurse :: String -> Integer -> (Maybe Message) -> IO ()
recurse username latest_status_id maybe_message = do
thread_sleep heartbeat
return ()
+-- |Try continually to download username's timeline, and determine the
+-- latest status id to be posted once we have done so.
get_latest_status_id :: String -> IO Integer
get_latest_status_id username = do
xmldata <- get_user_timeline username
+-- |This function wraps two steps. First, we need to find the latest
+-- status id posted by username. Once we have that, we can begin the
+-- recursive loop that checks for updates forever. The message
+-- argument is optional and is passed to recurse in case the updates
+-- should be emailed.
run_twat :: Maybe Message -> String -> IO ()
run_twat message username = do
latest_status_id <- get_latest_status_id username
return ()
+-- |The main function just parses the command-line arguments and then
+-- forks off calls to 'run_twat' for each supplied username. After
+-- forking, main loops forever.
main :: IO ()
main = do
errors <- parse_errors
import Network.Curl
import System.IO (hPutStrLn, stderr)
+-- |The API URL of username's timeline.
--
--- http://dev.twitter.com/doc/get/statuses/user_timeline
+-- See,
+--
+-- <http://dev.twitter.com/doc/get/statuses/user_timeline>
--
user_timeline_url :: String -> String
user_timeline_url username =
"&include_rts=true",
"&count=10" ]
+-- |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) ]
+-- |Return's username's timeline, or 'Nothing' if there was an error.
get_user_timeline :: String -> IO (Maybe String)
get_user_timeline username = do
let uri = (user_timeline_url username)
return timeline
+-- Returns the XML 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 username last_status_id = do
let uri = (user_new_statuses_url username last_status_id)
return new_statuses
+-- |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
resp <- curlGetString uri [CurlTimeout 45]
+-- |Functions and data for working with Twitter statuses.
module Twitter.Status
where
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,
deriving (Show, Eq)
-
+-- |Given some XML content, create a 'Status' from it.
status_from_content :: Content -> (Maybe Status)
status_from_content content =
first_user = user_from_content (users !! 0)
-
+-- |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
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.
+-- |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 = ""
+-- |Returns a nicely-formatted String representing the given 'Status'
+-- object.
pretty_print :: Status -> String
pretty_print status =
concat [ name,
+-- |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
get_max_status_id statuses =
maximum status_ids
where
- status_ids = map status_id statuses
\ No newline at end of file
+ status_ids = map status_id statuses
+-- | Functions and data for working with Twitter users.
module Twitter.User
where
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 -> (Maybe User)
user_from_content c =
if (length names) == 0
+-- |Application-specific XML functions.
module Twitter.Xml
where
import Text.Regex (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 -> (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 <status> tags within <statuses>.
all_statuses :: CFilter
all_statuses = (tag "statuses" /> tag "status")
--- Called unique_id here because status_id is used elsewhere.
+-- |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
unique_id = keep /> (tag "id") /> txt
+-- |Finds the text of the <created_at> element contained within some
+-- other element.
status_created_at :: CFilter
status_created_at = keep /> (tag "created_at") /> txt
+-- |Finds the text of the <text> element contained within some
+-- other element.
status_text :: CFilter
status_text = keep /> (tag "text") /> txt
+-- |Finds the XML of the <user> element contained within some other
+-- element.
status_user :: CFilter
status_user = keep /> (tag "user")
+-- |Finds the text of the <screen_name> element contained within some
+-- other element.
user_screen_name :: CFilter
user_screen_name = keep /> (tag "screen_name") /> txt
+-- |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.
xml_entities :: [(String, String)]
xml_entities = [("[lr]dquo", "\""),
("[mn]dash", "-"),
("lt", "<"),
("gt", ">")]
+-- |Replace all of the XML entities in target.
replace_entities :: String -> String
replace_entities target = unescape_recursive xml_entities 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 =
projects / dead / halcyon.git / commitdiff