From 35e0551101fa2267f28ff434a6006a3612ad54c9 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Thu, 28 Jun 2012 16:11:20 -0400 Subject: [PATCH] Attempt to implement article downloading. --- src/Configuration.hs | 3 ++- src/LWN/HTTP.hs | 11 +++++++-- src/Main.hs | 54 +++++++++++++++++++++++++++++++------------- 3 files changed, 49 insertions(+), 19 deletions(-) diff --git a/src/Configuration.hs b/src/Configuration.hs index 457480a..5745d09 100644 --- a/src/Configuration.hs +++ b/src/Configuration.hs @@ -1,6 +1,7 @@ module Configuration ( Cfg(..), - get_cfg + get_cfg, + use_account ) where diff --git a/src/LWN/HTTP.hs b/src/LWN/HTTP.hs index 743a99c..3793f10 100644 --- a/src/LWN/HTTP.hs +++ b/src/LWN/HTTP.hs @@ -18,8 +18,8 @@ import Network.Curl ( ) import Network.Curl.Download (openURI) import System.Directory (doesFileExist, getTemporaryDirectory) -import System.IO (hPutStrLn, stderr) -import System.IO.Temp (openBinaryTempFile) +import System.IO (hClose, hPutStrLn, stderr) +import System.IO.Temp (openBinaryTempFile, openTempFile) import LWN.URI (filename) @@ -51,6 +51,13 @@ default_curl_opts = CurlVerbose True ] +make_cookie_jar :: IO FilePath +make_cookie_jar = do + temp_dir <- getTemporaryDirectory + let file_name_template = "lwn-epub-cookies.txt" + (out_path, out_handle) <- openTempFile temp_dir file_name_template + hClose out_handle -- We just want to create it for now. + return out_path get_page :: Maybe FilePath -> URLString -> IO (Maybe String) get_page cookie_jar url = diff --git a/src/Main.hs b/src/Main.hs index 924b9a5..4cc4216 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,13 +1,17 @@ -{-# LANGUAGE ScopedTypeVariables, RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables, RecordWildCards, DoAndIfThenElse #-} module Main where +import Control.Monad (when) +import Data.Maybe (fromJust) import Prelude hiding (readFile) import System.Directory (doesFileExist) import System.IO ( Handle, IOMode (WriteMode), + hPutStrLn, openBinaryFile, + stderr, stdout ) import System.IO.UTF8 (readFile) @@ -15,11 +19,12 @@ import Test.HUnit (Assertion, assertEqual) import Test.Framework (Test, testGroup) import Test.Framework.Providers.HUnit (testCase) import Text.Regex.Posix ((=~)) -import Text.XML.HXT.Core +import Text.XML.HXT.Core hiding (when) import CommandLine (show_help) -import Configuration (Cfg(..), get_cfg) -import LWN.Page +import Configuration (Cfg(..), get_cfg, use_account) +import LWN.HTTP (get_page, log_in, make_cookie_jar) +import LWN.Page (epublish, parse) import LWN.URI (is_lwn_url, make_absolute_url, make_https) import Misc (contains) @@ -35,17 +40,36 @@ my_read = readString my_read_opts -- | Try to parse the given article using HXT. We try a few different -- methods; if none of them work, we return 'Nothing'. -get_xml_from_article :: String -> IO (Maybe (IOStateArrow s b XmlTree)) -get_xml_from_article s = do - article <- real_article_path s - is_file <- doesFileExist article +get_xml_from_article :: Cfg -> IO (Maybe (IOStateArrow s b XmlTree)) +get_xml_from_article cfg = do + my_article <- real_article_path (article cfg) + is_file <- doesFileExist my_article case is_file of True -> do - contents <- readFile article + contents <- readFile my_article return $ Just $ my_read contents False -> do -- Download the URL and try to parse it. - return Nothing + if use_account cfg then do + -- use_account would be false if these fromJusts would fail. + cj <- make_cookie_jar + li_result <- log_in cj + (fromJust $ username cfg) + (fromJust $ password cfg) + when (not li_result) $ do + hPutStrLn stderr "Failed to log in." + + html <- get_page (Just cj) my_article + return $ + case html of + Nothing -> Nothing + Just h -> Just $ my_read h + else do + html <- get_page Nothing my_article + return $ + case html of + Nothing -> Nothing + Just h -> Just $ my_read h -- | If we're given an empty path, return a handle to -- 'stdout'. Otherwise, open the given file and return a read/write @@ -87,12 +111,12 @@ real_article_path s = do main :: IO () main = do - Cfg{..} <- get_cfg - output_handle <- get_output_handle output - maybe_html <- get_xml_from_article article + cfg <- get_cfg + output_handle <- get_output_handle (output cfg) - case maybe_html of + maybe_html <- get_xml_from_article cfg + case maybe_html of Just html -> do result <- parse html case result of @@ -106,7 +130,6 @@ main = do return () - test_current_article_path :: Assertion test_current_article_path = do let expected = "https://lwn.net/current" @@ -139,4 +162,3 @@ main_tests = testCase "Numbered article path constructed" test_numbered_article_path, testCase "Full article path left alone" test_full_article_path, testCase "Non-https URL made https" test_non_https_article_path ] - \ No newline at end of file -- 2.43.2