X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Flwn-epub.git;a=blobdiff_plain;f=src%2FMain.hs;h=5ce40269bd950a382201501f2101ed7ba7505ccf;hp=74971fdb05529f7feefad0bc9486e19d38f2e727;hb=f3321e2ce7d7645ad562dc8f6620bfd561edc75d;hpb=96249c993a34237c6e6df772eb36858e70ce9b34;ds=sidebyside diff --git a/src/Main.hs b/src/Main.hs index 74971fd..5ce4026 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,7 +2,6 @@ module Main where -import Data.List (isPrefixOf) import Data.Maybe (fromJust) import Prelude hiding (readFile) import System.Directory (doesFileExist) @@ -12,44 +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, - try_make_absolute_url, - make_https) - - - -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 -- | Try to parse the given article using HXT. We try a few different @@ -61,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 @@ -85,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 @@ -93,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 @@ -106,27 +81,6 @@ 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 path = do - is_file <- doesFileExist path - return $ if is_file then path else add_trailing_slash check_cases - where - abs_current = try_make_absolute_url ("/" ++ path) - abs_article = try_make_absolute_url ("Articles/" ++ path) - - check_cases :: String - check_cases - | is_lwn_url path = make_https path - | isPrefixOf "current" path = abs_current - | path =~ "^[0-9]+$" = abs_article - | otherwise = path -- Give up - main :: IO () main = do cfg <- get_cfg @@ -145,46 +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_current_bigpage_article_path :: Assertion -test_current_bigpage_article_path = do - let expected = "https://lwn.net/current/bigpage" - actual <- real_article_path "current/bigpage" - assertEqual "Current bigpage 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 - "Current bigpage article path constructed" - test_current_bigpage_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 ]