X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Flwn-epub.git;a=blobdiff_plain;f=src%2FMain.hs;h=655f1bef40c0680bda2c98e2d4ae9bc6f06c2cd8;hp=373d423c9f322ba885db966fecff5b7e190c4dd4;hb=6789361c1ee570df06878535aff73d99b87528a5;hpb=6f0e6cbece7e1b1a3c6b43d19eb2f29088af981c diff --git a/src/Main.hs b/src/Main.hs index 373d423..655f1be 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,24 +2,44 @@ module Main where +import Prelude hiding (readFile) +import System.Directory(doesFileExist) import System.IO ( Handle, IOMode (WriteMode), openBinaryFile, stdout ) +import System.IO.UTF8 (readFile) import Text.XML.HXT.Core -import CommandLine (Args(..), apply_args) +import CommandLine (Args(..), apply_args, show_help) import LWN.Page -my_read :: String -> IOStateArrow s b XmlTree -my_read = - readDocument [ withValidate no, + +my_read_opts :: SysConfigList +my_read_opts = [ withValidate no, withParseHTML yes, - withInputEncoding utf8, withWarnings no ] +-- | 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 +-- methods; if none of them work, we return 'Nothing'. +get_xml_from_article :: String -> IO (Maybe (IOStateArrow s b XmlTree)) +get_xml_from_article s = do + article <- real_article_path s + is_file <- doesFileExist article + case is_file of + True -> do + contents <- readFile article + return $ Just $ my_read contents + False -> do + -- Download the URL and try to parse it. + return Nothing + -- | 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. @@ -43,12 +63,18 @@ main :: IO () main = do Args{..} <- apply_args output_handle <- get_output_handle output - input_path <- real_article_path article - let html = my_read input_path - result <- parse html + maybe_html <- get_xml_from_article article + + case maybe_html of + + Just html -> do + result <- parse html + case result of + Just stuff -> epublish stuff output_handle + Nothing -> return () - case result of - Just stuff -> epublish stuff output_handle - Nothing -> return () + Nothing -> do + _ <- show_help + return () putStrLn "Done."