From 69b8af30f49aaad0f5c051998d2556b9ec291df7 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Tue, 28 Sep 2010 18:29:51 -0400 Subject: [PATCH] Add Haddock documentation for most functions and types. --- src/CommandLine.hs | 25 ++++++++++++++++--------- src/ExitCodes.hs | 5 +++-- src/Mail.hs | 13 ++++++++++++- src/Main.hs | 30 ++++++++++++++++++++++++++---- src/Twitter/Http.hs | 13 ++++++++++++- src/Twitter/Status.hs | 20 ++++++++++++++------ src/Twitter/User.hs | 4 ++++ src/Twitter/Xml.hs | 22 +++++++++++++++++++++- 8 files changed, 108 insertions(+), 24 deletions(-) diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 19b8d1b..da6a04b 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -1,7 +1,6 @@ --- 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, @@ -17,27 +16,27 @@ import System.Environment (getArgs) --- 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 +-- -- options :: [OptDescr (Options -> IO Options)] options = @@ -85,6 +84,7 @@ parse_options = do return opts +-- |Parse errors relating to the list of usernames. username_errors :: IO [String] username_errors = do argv <- getArgs @@ -95,6 +95,7 @@ username_errors = do else return [] +-- |Parse errors relating to the "To" address. to_errors :: IO [String] to_errors = do toaddr <- to_email_address @@ -103,6 +104,8 @@ to_errors = do 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 @@ -112,11 +115,12 @@ from_errors = do 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 @@ -126,24 +130,27 @@ parse_errors = do 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 diff --git a/src/ExitCodes.hs b/src/ExitCodes.hs index b190489..11c03f9 100644 --- a/src/ExitCodes.hs +++ b/src/ExitCodes.hs @@ -1,5 +1,6 @@ --- |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 diff --git a/src/Mail.hs b/src/Mail.hs index c280f1e..ba605f9 100644 --- a/src/Mail.hs +++ b/src/Mail.hs @@ -1,3 +1,5 @@ +-- |Email functions and data types. + module Mail where @@ -11,6 +13,7 @@ import System.IO type Header = String +-- |A crude model of an RFC821 email message. data Message = Message { headers :: [Header], subject :: String, body :: String, @@ -18,7 +21,10 @@ data Message = Message { headers :: [Header], 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", @@ -28,6 +34,8 @@ instance Show Message where (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", @@ -53,6 +61,9 @@ sendmail message = do 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 diff --git a/src/Main.hs b/src/Main.hs index ac33b2b..f42f2ce 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -14,21 +14,33 @@ import Twitter.Status 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 @@ -59,6 +71,8 @@ recurse username latest_status_id maybe_message = do 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 @@ -77,6 +91,11 @@ get_latest_status_id username = do +-- |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 @@ -84,6 +103,9 @@ run_twat message username = do 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 diff --git a/src/Twitter/Http.hs b/src/Twitter/Http.hs index 2fe24bd..d7135ce 100644 --- a/src/Twitter/Http.hs +++ b/src/Twitter/Http.hs @@ -4,8 +4,11 @@ where 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, +-- +-- -- user_timeline_url :: String -> String user_timeline_url username = @@ -14,12 +17,16 @@ 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) @@ -27,6 +34,8 @@ get_user_timeline username = do 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) @@ -34,6 +43,8 @@ get_user_new_statuses username last_status_id = do 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] diff --git a/src/Twitter/Status.hs b/src/Twitter/Status.hs index 93b3f4e..a2e6255 100644 --- a/src/Twitter/Status.hs +++ b/src/Twitter/Status.hs @@ -1,3 +1,4 @@ +-- |Functions and data for working with Twitter statuses. module Twitter.Status where @@ -7,6 +8,8 @@ import Text.XML.HaXml 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, @@ -14,7 +17,7 @@ data Status = Status { status_id :: Integer, deriving (Show, Eq) - +-- |Given some XML content, create a 'Status' from it. status_from_content :: Content -> (Maybe Status) status_from_content content = @@ -52,7 +55,8 @@ 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 @@ -63,12 +67,14 @@ parse_statuses xml_data = 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, @@ -84,8 +90,10 @@ pretty_print 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 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 diff --git a/src/Twitter/User.hs b/src/Twitter/User.hs index 217ee7d..a6fd3f6 100644 --- a/src/Twitter/User.hs +++ b/src/Twitter/User.hs @@ -1,3 +1,4 @@ +-- | Functions and data for working with Twitter users. module Twitter.User where @@ -5,10 +6,13 @@ 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 -> (Maybe User) user_from_content c = if (length names) == 0 diff --git a/src/Twitter/Xml.hs b/src/Twitter/Xml.hs index e4cf5ac..20015d3 100644 --- a/src/Twitter/Xml.hs +++ b/src/Twitter/Xml.hs @@ -1,3 +1,4 @@ +-- |Application-specific XML functions. module Twitter.Xml where @@ -5,32 +6,48 @@ import Data.Maybe 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 tags within . all_statuses :: CFilter all_statuses = (tag "statuses" /> tag "status") --- Called unique_id here because status_id is used elsewhere. +-- |Finds the text of the 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 element contained within some +-- other element. status_created_at :: CFilter status_created_at = keep /> (tag "created_at") /> txt +-- |Finds the text of the element contained within some +-- other element. status_text :: CFilter status_text = keep /> (tag "text") /> txt +-- |Finds the XML of the element contained within some other +-- element. status_user :: CFilter status_user = keep /> (tag "user") +-- |Finds the text of the 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", "-"), @@ -40,9 +57,12 @@ xml_entities = [("[lr]dquo", "\""), ("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 = -- 2.44.2