X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Flwn-epub.git;a=blobdiff_plain;f=src%2FMain.hs;h=4cc4216d0e02e3c81ccaff617acb97ff26033bc5;hp=924b9a558dd59df682d9cbdb3713fceaad0b27f1;hb=35e0551101fa2267f28ff434a6006a3612ad54c9;hpb=b18c060e5cb708901eb29f1f27b25c467875a143 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