X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Flwn-epub.git;a=blobdiff_plain;f=src%2FMain.hs;h=f0e81f76478bab18ec4bf625a474c036ec29f467;hp=924b9a558dd59df682d9cbdb3713fceaad0b27f1;hb=4f418d48ed53343f5547a79e325fdbb7e75a1da0;hpb=b18c060e5cb708901eb29f1f27b25c467875a143 diff --git a/src/Main.hs b/src/Main.hs index 924b9a5..f0e81f7 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,13 +1,17 @@ -{-# LANGUAGE ScopedTypeVariables, RecordWildCards #-} +{-# LANGUAGE 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,12 +19,13 @@ 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 LWN.URI (is_lwn_url, make_absolute_url, make_https) +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 (add_trailing_slash, is_lwn_url, make_absolute_url, make_https) import Misc (contains) @@ -35,17 +40,39 @@ 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 + print $ fromJust $ html + return $ + case html of + Nothing -> Nothing + Just h -> Just $ my_read h + else do + html <- get_page Nothing my_article + putStrLn "Not logged in." + print $ fromJust $ html + 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 @@ -67,7 +94,7 @@ get_output_handle path = real_article_path :: String -> IO String real_article_path s = do is_file <- doesFileExist s - return $ if is_file then s else check_cases + return $ if is_file then s else add_trailing_slash check_cases where abs_current = case make_absolute_url "current" of @@ -87,12 +114,15 @@ 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 + when (use_account cfg) $ do + putStrLn "Using account." + + maybe_html <- get_xml_from_article cfg + case maybe_html of Just html -> do result <- parse html case result of @@ -106,16 +136,15 @@ main = do return () - test_current_article_path :: Assertion test_current_article_path = do - let expected = "https://lwn.net/current" + let expected = "https://lwn.net/current/" actual <- real_article_path "current" assertEqual "Current article path constructed" expected actual test_numbered_article_path :: Assertion test_numbered_article_path = do - let expected = "https://lwn.net/Articles/69" + let expected = "https://lwn.net/Articles/69/" actual <- real_article_path "69" -- I'm twelve assertEqual "Numbered article path constructed" expected actual @@ -139,4 +168,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