From 1b72ed45ef890ed1329a32457b4d7f3a7fb37788 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Wed, 16 Jul 2014 11:16:25 -0400 Subject: [PATCH] Clean up a bunch of code and comments. Add some doctests for existing functions. --- src/CommandLine.hs | 49 ++++++++++++- src/Configuration.hs | 43 +++++++----- src/Html.hs | 28 ++++++++ src/Mail.hs | 132 +++++++++++++++++++++++++---------- src/Main.hs | 81 ++++++++++----------- src/OptionalConfiguration.hs | 27 ++++++- src/StringUtils.hs | 13 ++-- src/Twitter/Http.hs | 15 ++-- src/Twitter/Status.hs | 15 +++- src/Usernames.hs | 10 +++ 10 files changed, 305 insertions(+), 108 deletions(-) diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 65054fe..01b5a80 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -16,57 +16,100 @@ import System.Console.CmdArgs ( summary, typ, versionArg ) -import System.Environment (withArgs) +import System.Environment ( withArgs ) -- Get the version from Cabal. -import Paths_halcyon (version) -import Data.Version (showVersion) +import Paths_halcyon ( version ) +import Data.Version ( showVersion ) import OptionalConfiguration ( OptionalCfg(..) ) + +-- | The description of the program, displayed as part of the help. +-- description :: String description = "Monitor a list of Twitter accounts and display or email any new tweets." + +-- | The name of this program. +-- program_name :: String program_name = "halcyon" + +-- | A summary string output as part of the help. +-- my_summary :: String my_summary = program_name ++ "-" ++ (showVersion version) + +-- | Help string for the \"consumer_key\" option. +-- consumer_key_help :: String consumer_key_help = "Your Twitter API consumer key" + +-- | Help string for the \"consumer_secret\" option. +-- consumer_secret_help :: String consumer_secret_help = "Your Twitter API consumer secret" + +-- | Help string for the \"access_token\" option +-- access_token_help :: String access_token_help = "Your Twitter API access token" + +-- | Help string for the \"access_secret\" option. +-- access_secret_help :: String access_secret_help = "Your Twitter API access secret" + +-- | Help string for the \"heartbeat\" option. +-- heartbeat_help :: String heartbeat_help = "How many seconds to wait between polling" + +-- | Help string for the \"to_address\" option. +-- to_address_help :: String to_address_help = "Send tweets to ADDRESS" + +-- | Help string for the \"from_address\" option. +-- from_address_help :: String from_address_help = "Send tweets from ADDRESS" + +-- | Help string for the \"sendmail_path\" option. +-- sendmail_path_help :: String sendmail_path_help = "Use PATH to send mail" + +-- | Help string for the \"ignore_replies\" option. +-- ignore_replies_help :: String ignore_replies_help = "Ignore replies to other tweets" + +-- | Help string for the \"ignore_retweets\" option. +-- ignore_retweets_help :: String ignore_retweets_help = "Ignore retweets from other users" + +-- | Help string for the \"verbose\" option. +-- verbose_help :: String verbose_help = "Be verbose about stuff" + arg_spec :: OptionalCfg arg_spec = OptionalCfg { diff --git a/src/Configuration.hs b/src/Configuration.hs index 7865865..c213643 100644 --- a/src/Configuration.hs +++ b/src/Configuration.hs @@ -5,13 +5,18 @@ module Configuration ( Cfg(..), - default_config, merge_optional ) where +import System.Console.CmdArgs.Default ( Default(..) ) + import qualified OptionalConfiguration as OC ( OptionalCfg(..) ) import Usernames ( Usernames(..) ) + +-- | The main configuration data type. It contains all options that +-- can be set in a config file or on the command line. +-- data Cfg = Cfg { consumer_key :: String, consumer_secret :: String, @@ -20,7 +25,7 @@ data Cfg = heartbeat :: Int, ignore_replies :: Bool, ignore_retweets :: Bool, - sendmail_path :: String, + sendmail_path :: FilePath, from_address :: Maybe String, to_address :: Maybe String, verbose :: Bool, @@ -28,21 +33,27 @@ data Cfg = deriving (Show) -default_config :: Cfg -default_config = - Cfg { consumer_key = "", - consumer_secret = "", - access_token = "", - access_secret = "", - heartbeat = 600, - ignore_replies = False, - ignore_retweets = False, - sendmail_path = "/usr/sbin/sendmail", - from_address = Nothing, - to_address = Nothing, - verbose = False, - usernames = Usernames [] } +instance Default Cfg where + -- | A 'Cfg' with all of its fields set to their default values. + -- + def = Cfg { consumer_key = def, + consumer_secret = def, + access_token = def, + access_secret = def, + heartbeat = 600, + ignore_replies = def, + ignore_retweets = def, + sendmail_path = "/usr/sbin/sendmail", + from_address = def, + to_address = def, + verbose = def, + usernames = def } + +-- | Merge a 'Cfg' with an 'OptionalCfg'. This is more or less the +-- Monoid instance for 'OptionalCfg', but since the two types are +-- different, we have to repeat ourselves. +-- merge_optional :: Cfg -> OC.OptionalCfg -> Cfg merge_optional cfg opt_cfg = Cfg diff --git a/src/Html.hs b/src/Html.hs index 59876a5..3abd82b 100644 --- a/src/Html.hs +++ b/src/Html.hs @@ -7,6 +7,34 @@ import Test.Tasty ( TestTree, testGroup ) import Test.Tasty.HUnit ( (@?=), testCase ) import Text.HTML.TagSoup.Entity ( lookupEntity ) + +-- | Replace (x)html entities in a 'String'. To do this, we search +-- through the string looking for ampersands which may indicate the +-- beginning of an entity. +-- +-- If we find one and there's a semicolon after it, we attempt to +-- look up the identifier that we found between the ampersand and +-- the semicolon. If an entity is found, we replace the ampersand, +-- semicolon, and everything in between with the entity. However if +-- no corresponding entity is found, we leave everything alone. +-- +-- Examples: +-- +-- >>> replace_entities "Hello, world!" +-- "Hello, world!" +-- +-- >>> replace_entities "Hello; world!" +-- "Hello; world!" +-- +-- >>> replace_entities "Hello, world & other worlds!" +-- "Hello, world & other worlds!" +-- +-- >>> replace_entities "Hello, world & other worlds; hello indeed!" +-- "Hello, world & other worlds; hello indeed!" +-- +-- >>> putStrLn $ replace_entities "Hello world—I guess" +-- Hello world—I guess +-- replace_entities :: String -> String replace_entities [] = [] replace_entities ('&':xs) = diff --git a/src/Mail.hs b/src/Mail.hs index 3f519cc..3faa789 100644 --- a/src/Mail.hs +++ b/src/Mail.hs @@ -1,8 +1,7 @@ --- |Email functions and data types. +-- | Email functions and data types. module Mail ( Message(..), - default_headers, print_sendmail_result, rfc822_now, sendmail ) @@ -13,6 +12,7 @@ import Control.Exception ( evaluate ) import Control.Monad ( liftM ) import Data.List ( intercalate ) import Data.Time ( formatTime, getZonedTime ) +import System.Console.CmdArgs.Default ( Default(..) ) import System.Exit ( ExitCode(..) ) import System.Locale ( defaultTimeLocale, rfc822DateFormat ) import System.Process ( runInteractiveProcess, waitForProcess ) @@ -21,43 +21,73 @@ import System.IO ( hClose, hGetContents, hPutStr ) type Header = String --- | A crude model of an RFC821 email message. -data Message = Message { headers :: [Header], - subject :: String, - body :: String, - from :: String, - 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. +-- 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). -instance Show Message where - show m = - concat [ formatted_headers, - "Subject: " ++ (subject m) ++ "\n", - "From: " ++ (from m) ++ "\n", - "To: " ++ (to m) ++ "\n", - "\n", - (body m) ] - where - formatted_headers = - if null (headers m) - then "" - else (intercalate "\n" (headers m)) ++ "\n" + +-- | A crude model of an RFC822 email message. +-- +data Message = Message { headers :: [Header], + subject :: String, + body :: String, + from :: String, + to :: String } + deriving (Eq) + + +instance Default Message where + -- | Construct a message with all of its fields set to their + -- default values. + -- + def = Message default_headers def def def def + + +-- | Print a 'Message' in roughly RFC-compliant form. This form is +-- sufficient for handing the message off to sendmail (or compatible). +-- +-- Examples: +-- +-- >>> let hs = default_headers +-- >>> let s = "Save up to 20% on garbage!" +-- >>> let b = "Just kidding, now you have a virus!" +-- >>> let f = "savings5000@impenetrable.example" +-- >>> let t = "everyone@everywhere.example" +-- >>> let msg = Message hs s b f t +-- >>> putStrLn $ to_rfc822 msg +-- MIME-Version: 1.0 +-- Content-Type: text/plain; charset=UTF-8 +-- Content-Transfer-Encoding: 8bit +-- Subject: Save up to 20% on garbage! +-- From: savings5000@impenetrable.example +-- To: everyone@everywhere.example +-- +-- Just kidding, now you have a virus! +-- +to_rfc822 :: Message -> String +to_rfc822 m = + concat [ formatted_headers, + "Subject: " ++ (subject m) ++ "\n", + "From: " ++ (from m) ++ "\n", + "To: " ++ (to m) ++ "\n", + "\n", + (body m) ] + where + formatted_headers = + if null (headers m) + then "" + else (intercalate "\n" (headers m)) ++ "\n" -- | Constructs a 'String' in RFC822 date format for the current -- date/time. +-- rfc822_now :: IO String rfc822_now = liftM (formatTime defaultTimeLocale rfc822DateFormat) getZonedTime @@ -65,41 +95,73 @@ rfc822_now = --- |Takes a message as an argument, and passes it to the system's --- sendmail (or compatible) binary. +-- | Takes a message as an argument, and passes it to the system's +-- sendmail (or compatible) binary. +-- sendmail :: FilePath -> Message -> IO (String, String, ExitCode) sendmail sendmail_path message = do + -- The arguments we pass to sendmail "on the command line" let sendmail_args = ["-f", (from message), (to message)] + -- Run the sendmail process, passing it our sendmail_args. We'll get + -- back a bunch of handles, std{in,out,err} and one for the process + -- itself. (inh, outh, errh, ph) <- runInteractiveProcess sendmail_path sendmail_args Nothing Nothing + -- Create mvars for stdout and stderr, then collect their contents. outm <- newEmptyMVar outs <- hGetContents outh errm <- newEmptyMVar errs <- hGetContents errh - _ <- forkIO $ hPutStr inh (show message) >> hClose inh + -- Pass the message to sendmail on stdin + _ <- forkIO $ hPutStr inh (to_rfc822 message) >> hClose inh + + -- Fork threads that will read stdout/stderr respectively, and then + -- stick a dummy unit value in the mvars we created. _ <- forkIO $ evaluate (length outs) >> putMVar outm () _ <- forkIO $ evaluate (length errs) >> putMVar errm () + -- Now wait for the dummy variables to show up in the mvars. This + -- will occur only after (length outs) and (length errs) have been + -- evaluated, which can happen only after we've read them entirely. readMVar outm readMVar errm + -- Now wait for the process to finish and return its exit code along + -- with the output that we collected. ec <- waitForProcess ph 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. +-- | The 'sendmail' function returns a three-tuple of its outputs, +-- errors, and exit codes. This function pretty-prints one of those +-- three-tuples. +-- +-- If the exit code indicates success, we don't bother to print +-- anything (silence is golden!), but otherwise the contents of both +-- stdout and stderr will be printed. +-- +-- Examples: +-- +-- >>> let r = ("some output", "no errors", ExitSuccess) +-- >>> print_sendmail_result r +-- +-- >>> let r = ("some output", "lots of errors", ExitFailure 1) +-- >>> print_sendmail_result r +-- Output: some output +-- Errors: lots of errors +-- Exit Code: 1 +-- print_sendmail_result :: (String, String, ExitCode) -> IO () print_sendmail_result (outs, errs, ec) = case ec of ExitSuccess -> return () - _ -> putStrLn $ concat ["Output: " ++ outs, - "\nErrors: " ++ errs, - "\nExit Code: " ++ (show ec)] + ExitFailure (code) -> + putStrLn $ concat ["Output: " ++ outs, + "\nErrors: " ++ errs, + "\nExit Code: " ++ (show code)] diff --git a/src/Main.hs b/src/Main.hs index b7d7f71..3c33d1d 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -4,20 +4,19 @@ where import Control.Concurrent ( forkIO, threadDelay ) import Control.Monad ( forever, when ) import Data.Aeson ( decode ) -import Data.List ( (\\) ) import Data.Maybe ( fromMaybe, isNothing ) import Data.Monoid ( (<>) ) import Data.Time.LocalTime ( TimeZone, getCurrentTimeZone ) +import System.Console.CmdArgs.Default ( Default(..) ) import System.Exit ( ExitCode(..), exitWith ) import System.IO ( hPutStrLn, stderr ) import CommandLine ( get_args, show_help ) -import Configuration ( Cfg(..), default_config, merge_optional ) +import Configuration ( Cfg(..), merge_optional ) import ExitCodes ( exit_no_usernames ) import qualified OptionalConfiguration as OC ( from_rc ) import Mail ( Message(..), - default_headers, print_sendmail_result, rfc822_now, sendmail ) @@ -33,6 +32,7 @@ import Usernames ( Usernames(..) ) -- | 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)) @@ -40,21 +40,24 @@ thread_sleep seconds = do -- | 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. +-- 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 = "Halcyon: " ++ (screen_name (user status)), body = (pretty_print mtz status), headers = ((headers message) ++ ["Date: " ++ date])} where - date = - case created_at status of - Nothing -> default_date - Just c -> utc_time_to_rfc822 mtz c + date = maybe + default_date -- default + (utc_time_to_rfc822 mtz) -- function to apply if not Nothing + (created_at status) -- the Maybe thing --- | If the given Message is not Nothing, send a copy of it for every --- Status in the list. + +-- | If the given 'Message' is not 'Nothing', send a copy of it for +-- every 'Status' in the @statuses@ list. +-- send_messages :: Cfg -> Maybe TimeZone -> Maybe Message -> [Status] -> IO () send_messages cfg mtz maybe_message statuses = case maybe_message of @@ -64,13 +67,14 @@ send_messages cfg mtz maybe_message statuses = 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 - return () + mapM_ print_sendmail_result sendmail_results where sendmail' = sendmail (sendmail_path cfg) + -- | Display the number of skipped replies if ignore_replies is true -- and verbose is enabled. +-- mention_replies :: Cfg -> [Status] -> IO () mention_replies cfg ss = do let replies = filter reply ss @@ -81,6 +85,7 @@ mention_replies cfg ss = do -- | Display the number of skipped retweets if ignore_retweets is true -- and verbose is enabled. +-- mention_retweets :: Cfg -> [Status] -> IO () mention_retweets cfg ss = do let retweets = filter retweeted ss @@ -91,29 +96,27 @@ mention_retweets cfg ss = do -- | Filter out replies/retweets based on the configuration. +-- filter_statuses :: Cfg -> [Status] -> [Status] -filter_statuses cfg ss = - good_statuses +filter_statuses cfg statuses = + (reply_filter . retweet_filter) statuses where - replies = filter reply ss - retweets = filter retweeted ss - - good_statuses' = if (ignore_replies cfg) - then ss \\ replies - else ss - - good_statuses = if (ignore_retweets cfg) - then good_statuses' \\ retweets - else good_statuses' + reply_filter = if ignore_replies cfg + then filter (not . reply) + else id + retweet_filter = if ignore_retweets cfg + then filter (not . retweeted) + else id -- | This is the main recursive loop. It takes a the configuration, a -- username, a latest_status_id, and optionally a 'Message' as --- arguments. The latest_status_id is the last status (that we know +-- 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 :: Cfg -> String -> Integer -> (Maybe Message) -> IO () recurse cfg username latest_status_id maybe_message = do thread_sleep (heartbeat cfg) @@ -155,6 +158,7 @@ recurse cfg username latest_status_id maybe_message = do -- | 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 :: Cfg -> String -> IO Integer get_latest_status_id cfg username = do let delay = heartbeat cfg @@ -185,31 +189,28 @@ get_latest_status_id cfg username = do -- 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 :: Cfg -> Maybe Message -> String -> IO () run cfg msg username = do latest_status_id <- get_latest_status_id cfg username recurse cfg username latest_status_id msg - return () -- | Take advantage of the Maybe monad to only return a message when --- we have both a "to" and "from" address. +-- we have both a \"to\" and \"from\" address. +-- construct_message :: Cfg -> Maybe Message construct_message cfg = do to_addr <- to_address cfg from_addr <- from_address cfg - return $ make_msg to_addr from_addr - where - make_msg t f = Message { headers = default_headers, - body = "", - subject = "", - to = t, - from = f } - --- |The main function just parses the command-line arguments and then --- forks off calls to 'run' for each supplied username. After --- forking, main loops forever. + return $ def { to = to_addr, from = from_addr } + + +-- | The main function just parses the command-line arguments and then +-- forks off calls to 'run' for each supplied username. After +-- forking, main loops forever. +-- main :: IO () main = do -- And a Cfg object. @@ -222,7 +223,7 @@ main = do -- Finally, update a default config with any options that have been -- set in either the config file or on the command-line. - let cfg = merge_optional default_config opt_config + let cfg = merge_optional (def :: Cfg) opt_config when (null $ get_usernames (usernames cfg)) $ do hPutStrLn stderr "ERROR: no usernames supplied." diff --git a/src/OptionalConfiguration.hs b/src/OptionalConfiguration.hs index 607659e..8fd9f6c 100644 --- a/src/OptionalConfiguration.hs +++ b/src/OptionalConfiguration.hs @@ -23,6 +23,11 @@ import Data.Data ( Data ) import Data.Maybe ( fromMaybe ) import Data.Monoid ( Monoid(..) ) import Data.Typeable ( Typeable ) +import Paths_halcyon ( getSysconfDir ) +import System.Directory ( getHomeDirectory ) +import System.FilePath ( () ) +import System.IO ( hPutStrLn, stderr ) +import System.IO.Error ( catchIOError ) import Usernames ( Usernames(..) ) @@ -89,9 +94,29 @@ instance Monoid OptionalCfg where then cfg1 else cfg2 + +-- | Obtain an 'OptionalCfg' from halcyonrc in either the global +-- configuration directory or the user's home directory. The one in +-- $HOME is prefixed by a dot so that it is hidden. +-- +-- We make an attempt at cross-platform compatibility; we will try +-- to find the correct directory even on Windows. But if the calls +-- to getHomeDirectory/getSysconfDir fail for whatever reason, we +-- fall back to using the Unix-specific /etc and $HOME. +-- from_rc :: IO OptionalCfg from_rc = do - cfg <- DC.load [ DC.Optional "$(HOME)/.halcyonrc" ] + etc <- catchIOError getSysconfDir (\e -> do + hPutStrLn stderr (show e) + return "/etc") + home <- catchIOError getHomeDirectory (\e -> do + hPutStrLn stderr (show e) + return "$(HOME)") + let global_config_path = etc "halcyonrc" + let user_config_path = home ".halcyonrc" + cfg <- DC.load [ DC.Optional global_config_path, + DC.Optional user_config_path ] + cfg_consumer_key <- DC.lookup cfg "consumer-key" cfg_consumer_secret <- DC.lookup cfg "consumer-secret" cfg_access_token <- DC.lookup cfg "access-token" diff --git a/src/StringUtils.hs b/src/StringUtils.hs index a9e2625..e498c2e 100644 --- a/src/StringUtils.hs +++ b/src/StringUtils.hs @@ -7,12 +7,13 @@ where import Test.Tasty ( TestTree, testGroup ) import Test.Tasty.HUnit ( (@?=), testCase ) --- | Takes a list of strings, call them string1, string2, etc. and --- numbers them like a list. So, + +-- | Takes a list of strings and numbers it like an ordered list. +-- +-- Examples: -- --- 1. string1 --- 2. string2 --- 3. etc. +-- >>> listify ["foo", "bar", "baz"] +-- ["1. foo","2. bar","3. baz"] -- listify :: [String] -> [String] listify = @@ -23,7 +24,7 @@ listify = -- --- Tests +-- * Tests -- string_utils_tests :: TestTree diff --git a/src/Twitter/Http.hs b/src/Twitter/Http.hs index e3bb9fc..eec7ab7 100644 --- a/src/Twitter/Http.hs +++ b/src/Twitter/Http.hs @@ -21,6 +21,7 @@ import Web.Authenticate.OAuth ( import Configuration ( Cfg(..) ) + -- | The API URL of username's timeline. -- -- See, @@ -41,7 +42,8 @@ user_timeline_url username = -- | 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. +-- \"since_id\" parameter tacked on. +-- user_new_statuses_url :: String -> Integer -> String user_new_statuses_url username last_status_id = url ++ "&since_id=" ++ since_id @@ -51,6 +53,7 @@ user_new_statuses_url username last_status_id = -- | Return's username's timeline. +-- get_user_timeline :: Cfg -> String -> IO B.ByteString get_user_timeline cfg username = do let uri = user_timeline_url username @@ -58,14 +61,17 @@ get_user_timeline cfg username = do -- | Returns the JSON representing all of username's statuses that are --- newer than last_status_id. +-- newer than @last_status_id@. +-- get_user_new_statuses :: Cfg -> String -> Integer -> IO B.ByteString get_user_new_statuses cfg username last_status_id = do let uri = user_new_statuses_url username last_status_id http_get cfg uri --- | Retrieve a URL, or crash. +-- | Retrieve a URL, or crash. The request is signed using all of the +-- OAuth junk contained in the configuration. +-- http_get :: Cfg -> String -> IO B.ByteString http_get cfg url = do manager <- newManager tlsManagerSettings @@ -83,8 +89,7 @@ http_get cfg url = do oauth :: OAuth oauth = newOAuth { oauthConsumerKey = consumer_key', - oauthConsumerSecret = consumer_secret' - } + oauthConsumerSecret = consumer_secret' } credential :: Credential credential = newCredential access_token' access_secret' diff --git a/src/Twitter/Status.hs b/src/Twitter/Status.hs index 506a2c0..ba27d52 100644 --- a/src/Twitter/Status.hs +++ b/src/Twitter/Status.hs @@ -36,8 +36,8 @@ data Status = Status { reply :: Bool, retweeted :: Bool, text :: String, - user :: User - } deriving (Show, Eq) + user :: User } + deriving (Eq, Show) type Timeline = [Status] @@ -65,6 +65,8 @@ instance FromJSON Status where -- Do whatever. parseJSON _ = mempty +-- | Parse a timestamp from a status into a UTCTime (or Nothing). +-- parse_status_time :: String -> Maybe UTCTime parse_status_time = parseTime defaultTimeLocale status_format @@ -73,6 +75,10 @@ parse_status_time = status_format :: String status_format = "%a %b %d %H:%M:%S %z %Y" + +-- | Given a 'TimeZone', convert a 'UTCTime' into an RFC822-format +-- time string. If no 'TimeZone' is given, assume UTC. +-- utc_time_to_rfc822 :: Maybe TimeZone -> UTCTime -> String utc_time_to_rfc822 mtz utc = case mtz of @@ -82,10 +88,15 @@ utc_time_to_rfc822 mtz utc = foo = formatTime defaultTimeLocale rfc822DateFormat +-- | Get the 'created_at' time out of a 'Status' and display it as an +-- RFC822-format time string. If there's no created-at time in the +-- status, you'll get an empty string instead. +-- show_created_at :: Maybe TimeZone -> Status -> String show_created_at mtz = (maybe "" (utc_time_to_rfc822 mtz)) . created_at + -- | Returns a nicely-formatted String representing the given 'Status' -- object. -- diff --git a/src/Usernames.hs b/src/Usernames.hs index 92e5c43..6aec228 100644 --- a/src/Usernames.hs +++ b/src/Usernames.hs @@ -15,16 +15,26 @@ import System.Console.CmdArgs.Default ( Default(..) ) import Data.Typeable ( Typeable ) +-- | Wrapper around a list of strings (usernames). +-- newtype Usernames = Usernames { get_usernames :: [String] } deriving (Data, Show, Typeable) instance Default Usernames where + -- | The default list of usernames is empty. + -- def = Usernames [] + instance DCT.Configured Usernames where + -- | This allows us to read a 'Usernames' object out of a + -- Configurator config file. By default Configurator wouldn't know + -- what to do, so we have to tell it that we expect a list, and if + -- that list has strings in it, we can apply the Usernames + -- constructor to it. convert (DCT.List xs) = fmap Usernames (mapM convert_string xs) where -- 2.44.2