From eed0d7b0f8ef28864c00925beef5c8853bcd44cc Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Sat, 14 Dec 2013 17:59:17 -0500 Subject: [PATCH 1/1] Bump tagsoup dependency. Replace conduit/http-conduit with http-client(-tls). Simplify the command-line parsing. Explicitly import more stuff. --- halcyon.cabal | 12 +-- src/CommandLine.hs | 173 ++++++++++++++++++++---------------------- src/Html.hs | 2 +- src/Main.hs | 7 +- src/Twitter/Http.hs | 20 ++--- src/Twitter/Status.hs | 3 +- 6 files changed, 103 insertions(+), 114 deletions(-) diff --git a/halcyon.cabal b/halcyon.cabal index 8e8119f..e425797 100644 --- a/halcyon.cabal +++ b/halcyon.cabal @@ -20,16 +20,16 @@ executable halcyon base == 4.*, bytestring == 0.10.*, cmdargs >= 0.10.5, - conduit == 1.*, configurator == 0.2.*, directory == 1.2.*, - http-conduit == 1.9.*, + http-client == 0.2.*, + http-client-tls == 0.2.*, HUnit == 1.2.*, MissingH == 1.*, process == 1.*, old-locale == 1.*, regex-compat == 0.*, - tagsoup == 0.12.*, + tagsoup == 0.13.*, text == 0.11.*, time == 1.*, -- Test deps @@ -78,16 +78,16 @@ test-suite testsuite base == 4.*, bytestring == 0.10.*, cmdargs >= 0.10.5, - conduit == 1.*, configurator == 0.2.*, directory == 1.2.*, - http-conduit == 1.9.*, + http-client == 0.2.*, + http-client-tls == 0.2.*, HUnit == 1.2.*, MissingH == 1.*, process == 1.*, old-locale == 1.*, regex-compat == 0.*, - tagsoup == 0.12.*, + tagsoup == 0.13.*, text == 0.11.*, time == 1.*, -- Test deps diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 06c072e..862f9cd 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -1,20 +1,27 @@ module CommandLine ( - apply_args, - show_help - ) + get_args, + show_help) where -import System.Console.CmdArgs -import System.Console.CmdArgs.Explicit (process) -import System.Environment (getArgs, withArgs) -import System.Exit (ExitCode(..), exitWith) -import System.IO (hPutStrLn, stderr) +import System.Console.CmdArgs ( + (&=), + args, + cmdArgs, + def, + details, + groupname, + help, + helpArg, + program, + summary, + typ, + versionArg) +import System.Environment (withArgs) -- Get the version from Cabal. import Paths_halcyon (version) import Data.Version (showVersion) -import ExitCodes import OptionalConfiguration description :: String @@ -60,91 +67,73 @@ ignore_retweets_help = "Ignore retweets from other users" verbose_help :: String verbose_help = "Be verbose about stuff" -arg_spec :: Mode (CmdArgs OptionalCfg) +arg_spec :: OptionalCfg arg_spec = - cmdArgsMode $ - OptionalCfg { - consumer_key = - def &= typ "KEY" - &= groupname "Twitter API" - &= help consumer_key_help, - - consumer_secret = - def &= typ "SECRET" - &= groupname "Twitter API" - &= help consumer_secret_help, - - access_token = - def &= typ "TOKEN" - &= groupname "Twitter API" - &= help access_token_help, - - access_secret = - def &= typ "SECRET" - &= groupname "Twitter API" - &= help access_secret_help, - - heartbeat = - def &= groupname "Miscellaneous" - &= help heartbeat_help, - - ignore_replies = - def &= groupname "Miscellaneous" - &= help ignore_replies_help, - - ignore_retweets = - def &= groupname "Miscellaneous" - &= help ignore_retweets_help, - - verbose = - def &= groupname "Miscellaneous" - &= help verbose_help, - - sendmail_path = - def &= typ "PATH" - &= groupname "Mail Options" - &= help sendmail_path_help, - - from_address = - def &= typ "ADDRESS" - &= groupname "Mail Options" - &= help from_address_help, - - to_address = - def &= typ "ADDRESS" - &= groupname "Mail Options" - &= help to_address_help, - - usernames = - def &= args - &= typ "USERNAMES" } - - &= program program_name - &= summary my_summary - &= details [description] - &= helpArg [groupname "Common flags"] - &= versionArg [groupname "Common flags"] + OptionalCfg { + consumer_key = + def &= typ "KEY" + &= groupname "Twitter API" + &= help consumer_key_help, + + consumer_secret = + def &= typ "SECRET" + &= groupname "Twitter API" + &= help consumer_secret_help, + + access_token = + def &= typ "TOKEN" + &= groupname "Twitter API" + &= help access_token_help, + + access_secret = + def &= typ "SECRET" + &= groupname "Twitter API" + &= help access_secret_help, + + heartbeat = + def &= groupname "Miscellaneous" + &= help heartbeat_help, + + ignore_replies = + def &= groupname "Miscellaneous" + &= help ignore_replies_help, + + ignore_retweets = + def &= groupname "Miscellaneous" + &= help ignore_retweets_help, + + verbose = + def &= groupname "Miscellaneous" + &= help verbose_help, + + sendmail_path = + def &= typ "PATH" + &= groupname "Mail Options" + &= help sendmail_path_help, + + from_address = + def &= typ "ADDRESS" + &= groupname "Mail Options" + &= help from_address_help, + + to_address = + def &= typ "ADDRESS" + &= groupname "Mail Options" + &= help to_address_help, + + usernames = + def &= args + &= typ "USERNAMES" } + + &= program program_name + &= summary my_summary + &= details [description] + &= helpArg [groupname "Common flags"] + &= versionArg [groupname "Common flags"] show_help :: IO OptionalCfg -show_help = withArgs ["--help"] parse_args >>= cmdArgsApply +show_help = withArgs ["--help"] get_args - -parse_args :: IO (CmdArgs OptionalCfg) -parse_args = do - x <- getArgs - let y = process arg_spec x - case y of - Right result -> return result - Left err -> do - hPutStrLn stderr err - exitWith (ExitFailure exit_args_parse_failed) - - --- | Really get the command-line arguments. This calls 'parse_args' --- first to replace the default "wrong number of arguments" error, --- and then runs 'cmdArgsApply' on the result to do what the --- 'cmdArgs' function usually does. -apply_args :: IO OptionalCfg -apply_args = - parse_args >>= cmdArgsApply +get_args :: IO OptionalCfg +get_args = cmdArgs arg_spec diff --git a/src/Html.hs b/src/Html.hs index 2a3b483..01004cf 100644 --- a/src/Html.hs +++ b/src/Html.hs @@ -14,7 +14,7 @@ replace_entities [] = [] replace_entities ('&':xs) = let (b, a) = break (== ';') xs in case (lookupEntity b, a) of - (Just c, ';':as) -> c : replace_entities as + (Just s, ';':as) -> s ++ replace_entities as _ -> '&' : replace_entities xs replace_entities (x:xs) = x : replace_entities xs diff --git a/src/Main.hs b/src/Main.hs index 942b512..17442f4 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -20,8 +20,7 @@ import Mail ( default_headers, print_sendmail_result, rfc822_now, - sendmail - ) + sendmail) import Twitter.Http import Twitter.Status import Twitter.User @@ -135,7 +134,7 @@ recurse cfg username latest_status_id maybe_message = do tz <- getCurrentTimeZone let mtz = Just tz - mapM_ (putStrLn . (pretty_print mtz)) good_statuses + mapM_ (putStr . (pretty_print mtz)) good_statuses send_messages cfg mtz maybe_message good_statuses @@ -210,7 +209,7 @@ main :: IO () main = do -- And a Cfg object. rc_cfg <- OC.from_rc - cmd_cfg <- apply_args + cmd_cfg <- get_args -- Merge the config file options with the command-line ones, -- prefering the command-line ones. diff --git a/src/Twitter/Http.hs b/src/Twitter/Http.hs index be10b86..14d1563 100644 --- a/src/Twitter/Http.hs +++ b/src/Twitter/Http.hs @@ -7,9 +7,13 @@ where 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 Network.HTTP.Client ( + httpLbs, + newManager, + parseUrl, + responseBody) +import Network.HTTP.Client.TLS ( + tlsManagerSettings) import Web.Authenticate.OAuth ( OAuth(..), Credential, @@ -66,13 +70,11 @@ get_user_new_statuses cfg username last_status_id = do -- | Retrieve a URL, or crash. http_get :: Cfg -> String -> IO B.ByteString http_get cfg url = do - manager <- newManager def + manager <- newManager tlsManagerSettings request <- parseUrl url - - C.runResourceT $ do - signed_request <- signOAuth oauth credential request - response <- http signed_request manager - responseBody response C.$$+- sinkLbs + signed_request <- signOAuth oauth credential request + response <- httpLbs signed_request manager + return $ responseBody response where consumer_key' = BC.pack (consumer_key cfg) diff --git a/src/Twitter/Status.hs b/src/Twitter/Status.hs index 3508593..92cf899 100644 --- a/src/Twitter/Status.hs +++ b/src/Twitter/Status.hs @@ -7,8 +7,7 @@ module Twitter.Status ( get_max_status_id, pretty_print, status_tests, - utc_time_to_rfc822 - ) + utc_time_to_rfc822) where import Control.Applicative ((<$>), (<*>)) -- 2.43.2