Bump tagsoup dependency.

Replace conduit/http-conduit with http-client(-tls).
Simplify the command-line parsing.
Explicitly import more stuff.

diff --git a/halcyon.cabal b/halcyon.cabal
index 8e8119f1c0cd1ea6557c852bed4788fd67f3c63b..e425797b10a40cfec9144f28527517b378a7e64e 100644 (file)
--- a/halcyon.cabal
+++ b/halcyon.cabal
@@ -20,16 +20,16 @@ executable halcyon
     base                        == 4.*,
     bytestring                  == 0.10.*,
     cmdargs                     >= 0.10.5,
     base                        == 4.*,
     bytestring                  == 0.10.*,
     cmdargs                     >= 0.10.5,

-    conduit                     == 1.*,

     configurator                == 0.2.*,
     directory                   == 1.2.*,
     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.*,
     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
     text                        == 0.11.*,
     time                        == 1.*,
     -- Test deps


@@ -78,16 +78,16 @@ test-suite testsuite
     base                        == 4.*,
     bytestring                  == 0.10.*,
     cmdargs                     >= 0.10.5,
     base                        == 4.*,
     bytestring                  == 0.10.*,
     cmdargs                     >= 0.10.5,

-    conduit                     == 1.*,

     configurator                == 0.2.*,
     directory                   == 1.2.*,
     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.*,
     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
     text                        == 0.11.*,
     time                        == 1.*,
     -- Test deps

diff --git a/src/CommandLine.hs b/src/CommandLine.hs
index 06c072e8715af292cb8a5d83ffa5ed0cd29b2aa4..862f9cd9ad92200bd698a41cccbad83f03040230 100644 (file)
--- a/src/CommandLine.hs
+++ b/src/CommandLine.hs
@@ -1,20 +1,27 @@
 module CommandLine (
 module CommandLine (

-  apply_args,
-  show_help
-  )
+  get_args,
+  show_help)

 where
 
 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)
 
 
 -- Get the version from Cabal.
 import Paths_halcyon (version)
 import Data.Version (showVersion)
 

-import ExitCodes

 import OptionalConfiguration
 
 description :: String
 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"
 
 verbose_help :: String
 verbose_help = "Be verbose about stuff"
 

-arg_spec :: Mode (CmdArgs OptionalCfg)
+arg_spec :: OptionalCfg

 arg_spec =
 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 :: 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 2a3b4838b9b22a363b2c80f43476832ee4f3c616..01004cf556b01f3dde21fd8b9585b82732c5b009 100644 (file)
--- 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
 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
 
     _                -> '&' : replace_entities xs
 replace_entities (x:xs) = x : replace_entities xs
 

diff --git a/src/Main.hs b/src/Main.hs
index 942b512f78716aaf2b62907fd19ec36e6a32809c..17442f4571635d7363f4ebf5e336bace3e83d0b4 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -20,8 +20,7 @@ import Mail (
   default_headers,
   print_sendmail_result,
   rfc822_now,
   default_headers,
   print_sendmail_result,
   rfc822_now,

-  sendmail
-  )
+  sendmail)

 import Twitter.Http
 import Twitter.Status
 import Twitter.User
 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
 
       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
 
 
       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
 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.
 
   -- 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 be10b8697a5be241a23b22ca0e8b5b197ab54013..14d156395426eed5bf40af35942ec220aa646762 100644 (file)
--- 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.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,
 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
 -- | 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
   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)
 
   where
     consumer_key' = BC.pack (consumer_key cfg)

diff --git a/src/Twitter/Status.hs b/src/Twitter/Status.hs
index 3508593d2ee3af92472d734ee71815bef97ed744..92cf899fae1786562ad96b0c7e7a98ac5915e645 100644 (file)
--- 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,
   get_max_status_id,
   pretty_print,
   status_tests,

-  utc_time_to_rfc822
-  )
+  utc_time_to_rfc822)

 where
 
 import Control.Applicative ((<$>), (<*>))
 where
 
 import Control.Applicative ((<$>), (<*>))