X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Flwn-epub.git;a=blobdiff_plain;f=src%2FLWN%2FHTTP.hs;h=7da6ed1488d97114247091476c26b57ace5cc7d8;hp=4cfcb04bfbc389c6c75f539516249ee91145b882;hb=aad40cd8e1e8c84c5fc294674a7159bb40838440;hpb=2953924e2016393a1ffb9e2e82b4c90c8c57dfd3 diff --git a/src/LWN/HTTP.hs b/src/LWN/HTTP.hs index 4cfcb04..7da6ed1 100644 --- a/src/LWN/HTTP.hs +++ b/src/LWN/HTTP.hs @@ -5,6 +5,7 @@ where import qualified Data.ByteString as B (hPut) import qualified Data.Map as Map (Map, empty, insert) +import Data.Maybe (fromJust) import Network.Curl ( CurlCode(..), CurlOption(..), @@ -18,8 +19,11 @@ import Network.Curl ( import Network.Curl.Download (openURI) import System.Directory (doesFileExist, getTemporaryDirectory) import System.IO (hClose, hPutStrLn, stderr) +import qualified System.IO.UTF8 as Utf8 (readFile) import System.IO.Temp (openBinaryTempFile, openTempFile) +import qualified Configuration as C (Cfg, password, use_account, username) +import LWN.Article (real_article_path) import LWN.URI (URL, filename) login_url :: URL @@ -182,3 +186,47 @@ download_image_urls image_urls = do my_insert :: ImageMap -> (URL, Maybe FilePath) -> ImageMap my_insert dict (_, Nothing) = dict my_insert dict (k, Just v) = Map.insert k v dict + + +-- | Try to parse the given article using HXT. We try a few different +-- methods; if none of them work, we return 'Nothing'. +get_article_contents :: C.Cfg -> URL -> IO (Maybe String) +get_article_contents cfg article_name = do + my_article <- real_article_path article_name + is_file <- doesFileExist my_article + case is_file of + True -> do + contents <- Utf8.readFile my_article + return $ Just $ contents + False -> do + -- Download the URL and try to parse it. + if C.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 $ C.username cfg) + (fromJust $ C.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 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 h