X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Flwn-epub.git;a=blobdiff_plain;f=src%2FMain.hs;h=5ce40269bd950a382201501f2101ed7ba7505ccf;hp=2700038032651efec82cf886161abdac603a6633;hb=f3321e2ce7d7645ad562dc8f6620bfd561edc75d;hpb=e9151ade502fa997be41b6e37fb9841cacd0f528 diff --git a/src/Main.hs b/src/Main.hs index 2700038..5ce4026 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,9 +2,7 @@ module Main where -import Control.Concurrent (threadDelay) -import Control.Monad (when) -import Data.Maybe (fromJust, isJust) +import Data.Maybe (fromJust) import Prelude hiding (readFile) import System.Directory (doesFileExist) import System.IO ( @@ -13,48 +11,19 @@ import System.IO ( hPutStrLn, openBinaryFile, stderr, - stdout - ) + 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 ( IOStateArrow, - SysConfigList, - XmlTree, - no, - readString, - withParseHTML, - withValidate, - withWarnings, - yes - ) + XmlTree) + import CommandLine (show_help) 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.URI (add_trailing_slash, is_lwn_url, make_absolute_url, make_https) -import Misc (contains) - - -my_read_opts :: SysConfigList -my_read_opts = [ withValidate no, - withParseHTML yes, - withWarnings no ] +import LWN.XHTML (parse_lwn) --- | My version of HandsomeSoup's parseHTML. -my_read :: String -> IOStateArrow s b XmlTree -my_read = readString my_read_opts - - --- |A wrapper around threadDelay which takes seconds instead of --- microseconds as its argument. -thread_sleep :: Int -> IO () -thread_sleep seconds = do - let microseconds = seconds * (10 ^ (6 :: Int)) - threadDelay microseconds -- | Try to parse the given article using HXT. We try a few different @@ -66,7 +35,7 @@ get_xml_from_article cfg = do case is_file of True -> do contents <- readFile my_article - return $ Just $ my_read contents + return $ Just $ parse_lwn contents False -> do -- Download the URL and try to parse it. if use_account cfg then do @@ -76,13 +45,12 @@ get_xml_from_article cfg = do (fromJust $ username cfg) (fromJust $ password cfg) - -- Without this, the cookie file is empty during - -- get_page. Whaaat? - thread_sleep 1 - - when (isJust li_result) $ do - let msg = "Failed to log in. " ++ (fromJust li_result) - hPutStrLn stderr msg + 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 @@ -91,7 +59,7 @@ get_xml_from_article cfg = do let msg = "Failed to retrieve page. " ++ err hPutStrLn stderr msg return Nothing - Right h -> return $ Just $ my_read h + Right h -> return $ Just $ parse_lwn h else do html <- get_page Nothing my_article case html of @@ -99,7 +67,8 @@ get_xml_from_article cfg = do let msg = "Failed to retrieve page. " ++ err hPutStrLn stderr msg return Nothing - Right h -> return $ Just $ my_read h + 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 @@ -112,41 +81,10 @@ 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 add_trailing_slash 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 cfg) - - when (use_account cfg) $ do - putStrLn "Using account." - maybe_html <- get_xml_from_article cfg case maybe_html of @@ -161,37 +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 ]