X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Flwn-epub.git;a=blobdiff_plain;f=src%2FMain.hs;h=1f6d7c5f436a583d5143b05c1cf55aaf4126995e;hp=a810bc9d9ab04f4c14b9288dd0e7ea1a14527d0a;hb=291c39f59e958a012dd6e4ddec9b0276a4045b45;hpb=d5bab2c486d30e54d3e94cc3bdbb230f2cd1f3f3 diff --git a/src/Main.hs b/src/Main.hs index a810bc9..1f6d7c5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,17 +1,58 @@ -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DoAndIfThenElse #-} module Main where -import Data.Maybe (fromJust) -import Text.HandsomeSoup (parseHtml) +import Control.Concurrent.ParallelIO (stopGlobalPool) +import System.Directory (doesFileExist) +import System.IO ( + Handle, + IOMode (WriteMode), + hPutStrLn, + openBinaryFile, + stderr, + stdout + ) -import Epublishable -import LWN.ArticlePage +import CommandLine (show_help) +import Configuration (Cfg(..), get_cfg) +import LWN.Article (real_article_path) +import LWN.HTTP (get_login_cookie) +import LWN.Page (epublish, page_from_url) + + +-- | 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 + + +argument_is_file :: Cfg -> IO Bool +argument_is_file cfg = do + path <- real_article_path (article cfg) + doesFileExist path main :: IO () main = do - article_html <- readFile "test/fixtures/501317-article.html" - ioap <- parse $ parseHtml article_html - let article_page :: ArticlePage = fromJust $ ioap - epublish article_page "out.epub" - putStrLn "Done." + cfg' <- get_cfg + aif <- argument_is_file cfg' + cfg <- case aif of + False -> get_login_cookie cfg' + True -> return cfg' + + page <- page_from_url cfg (article cfg) + case page of + Just p -> do + output_handle <- get_output_handle (output cfg) + epublish p output_handle + Nothing -> do + hPutStrLn stderr "ERROR: could not parse an LWN page from the given URL." + _ <- show_help + return () + + -- Necessary, for some reason. + stopGlobalPool