X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Flwn-epub.git;a=blobdiff_plain;f=src%2FMain.hs;h=981a70531d717c1c7bef8f3fa874d26e943140eb;hp=8687488f7817281760813cd06cdbc24a06ffb44f;hb=4220827f62d772d7edcbdcc1c2f13d6c2eb5f534;hpb=ed2ed8abd62ba3dec7f799253de1133732f8c153 diff --git a/src/Main.hs b/src/Main.hs index 8687488..981a705 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,43 +1,101 @@ -{-# LANGUAGE ScopedTypeVariables, RecordWildCards #-} +{-# LANGUAGE DoAndIfThenElse #-} module Main where import Data.Maybe (fromJust) -import System.Console.CmdArgs (cmdArgsRun) +import Prelude hiding (readFile) +import System.Directory (doesFileExist) +import System.IO ( + Handle, + IOMode (WriteMode), + hPutStrLn, + openBinaryFile, + stderr, + stdout) +import System.IO.UTF8 (readFile) +import Text.XML.HXT.Core ( + IOStateArrow, + XmlTree) -import Text.XML.HXT.Core +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.XHTML (parse_lwn) -import CommandLine (Args(..), apply_args) -import Epublishable -import LWN.ArticlePage -import LWN.FullPage -my_read :: String -> IOStateArrow s b XmlTree -my_read = - readDocument [ withValidate no, - withParseHTML yes, - withInputEncoding utf8, - withWarnings no ] +-- | 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 :: 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 my_article + return $ Just $ parse_lwn contents + False -> do + -- Download the URL and try to parse it. + 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) -main :: IO () -main = do - Args{..} <- apply_args - print article + 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 - -- let article_html = my_read "test/fixtures/501317-article.html" - -- ioap <- parse article_html - -- let article_page :: ArticlePage = fromJust $ ioap - -- epublish article_page "single_article.epub" - -- let page_html = my_read "test/fixtures/500848-page.html" - -- ioap_f <- parse page_html - -- let full_page :: FullPage = fromJust $ ioap_f - -- epublish full_page "full_page.epub" +-- | If we're given an empty path, return a handle to +-- 'stdout'. Otherwise, open the given file and return a read/write +-- handle to that. +get_output_handle :: FilePath -> IO Handle +get_output_handle path = + if (null path) then + return stdout + else + openBinaryFile path WriteMode + + +main :: IO () +main = do + cfg <- get_cfg + output_handle <- get_output_handle (output cfg) + maybe_html <- get_xml_from_article cfg - -- let bigpage_html = my_read "test/fixtures/50844-bigpage.html" - -- ioap_bp <- parse bigpage_html - -- let bigpage :: FullPage = fromJust $ ioap_bp - -- epublish bigpage "bigpage.epub" + case maybe_html of + Just html -> do + result <- parse html + case result of + Just stuff -> epublish stuff output_handle + Nothing -> do + _ <- show_help + return () - -- putStrLn "Done." + Nothing -> do + _ <- show_help + return ()