X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Flwn-epub.git;a=blobdiff_plain;f=src%2FMain.hs;h=5ce40269bd950a382201501f2101ed7ba7505ccf;hp=924b9a558dd59df682d9cbdb3713fceaad0b27f1;hb=f3321e2ce7d7645ad562dc8f6620bfd561edc75d;hpb=b18c060e5cb708901eb29f1f27b25c467875a143 diff --git a/src/Main.hs b/src/Main.hs index 924b9a5..5ce4026 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,51 +1,74 @@ -{-# LANGUAGE ScopedTypeVariables, RecordWildCards #-} +{-# LANGUAGE DoAndIfThenElse #-} module Main where +import Data.Maybe (fromJust) import Prelude hiding (readFile) import System.Directory (doesFileExist) import System.IO ( Handle, IOMode (WriteMode), + hPutStrLn, openBinaryFile, - stdout - ) + stderr, + stdout) import System.IO.UTF8 (readFile) -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 ( + IOStateArrow, + XmlTree) import CommandLine (show_help) -import Configuration (Cfg(..), get_cfg) -import LWN.Page -import LWN.URI (is_lwn_url, make_absolute_url, make_https) -import Misc (contains) +import Configuration (Cfg(..), get_cfg, use_account) +import LWN.Article (real_article_path) +import LWN.HTTP (get_page, log_in, make_cookie_jar) +import LWN.Page (epublish, parse) +import LWN.XHTML (parse_lwn) -my_read_opts :: SysConfigList -my_read_opts = [ withValidate no, - withParseHTML yes, - withWarnings no ] - --- | My version of HandsomeSoup's parseHTML. -my_read :: String -> IOStateArrow s b XmlTree -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 - return $ Just $ my_read contents + contents <- readFile my_article + return $ Just $ parse_lwn 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) + + case li_result of + Left err -> do + let msg = "Failed to log in. " ++ err + hPutStrLn stderr msg + Right response_body -> do + hPutStrLn stderr response_body + + html <- get_page (Just cj) my_article + + case html of + Left err -> do + let msg = "Failed to retrieve page. " ++ err + hPutStrLn stderr msg + return Nothing + Right h -> return $ Just $ parse_lwn h + else do + html <- get_page Nothing my_article + case html of + Left err -> do + let msg = "Failed to retrieve page. " ++ err + hPutStrLn stderr msg + return Nothing + Right h -> return $ Just $ parse_lwn h + -- | If we're given an empty path, return a handle to -- 'stdout'. Otherwise, open the given file and return a read/write @@ -58,41 +81,13 @@ get_output_handle path = openBinaryFile path WriteMode - --- | Convert the given article to either a URL or a filesystem --- path. If the given article exists on the filesystem, we assume --- it's a file. Otherwise, we check to see if it's a URL. Failing --- that, we try to construct a URL from what we're given and do our --- best. -real_article_path :: String -> IO String -real_article_path s = do - is_file <- doesFileExist s - return $ if is_file then s else check_cases - where - abs_current = - case make_absolute_url "current" of - Nothing -> s - Just ac -> ac - abs_article = - case make_absolute_url ("Articles/" ++ s) of - Nothing -> s - Just as -> as - - check_cases :: String - check_cases - | is_lwn_url s = make_https s - | s `contains` "current" = abs_current - | s =~ "^[0-9]+$" = abs_article - | otherwise = s -- Give up - 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) + maybe_html <- get_xml_from_article cfg case maybe_html of - Just html -> do result <- parse html case result of @@ -104,39 +99,3 @@ main = do Nothing -> do _ <- show_help return () - - - -test_current_article_path :: Assertion -test_current_article_path = do - 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" - actual <- real_article_path "69" -- I'm twelve - assertEqual "Numbered article path constructed" expected actual - - -test_full_article_path :: Assertion -test_full_article_path = do - let expected = "https://lwn.net/Articles/502979/" - actual <- real_article_path "https://lwn.net/Articles/502979/" - assertEqual "Full article path left alone" expected actual - -test_non_https_article_path :: Assertion -test_non_https_article_path = do - let expected = "https://lwn.net/Articles/502979/" - actual <- real_article_path "http://lwn.net/Articles/502979/" - assertEqual "Non-https URL made https" expected actual - -main_tests :: Test -main_tests = - testGroup "Main Tests" [ - testCase "Current article path constructed" test_current_article_path, - 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