src/Main.hs

   1 {-# LANGUAGE DoAndIfThenElse #-}
   2 module Main
   3 where
   4
   5 import Data.Maybe (fromJust)
   6 import Prelude hiding (readFile)
   7 import System.Directory (doesFileExist)
   8 import System.IO (
   9   Handle,
  10   IOMode (WriteMode),
  11   hPutStrLn,
  12   openBinaryFile,
  13   stderr,
  14   stdout)
  15 import System.IO.UTF8 (readFile)
  16 import Text.XML.HXT.Core (
  17   IOStateArrow,
  18   XmlTree)
  19
  20 import CommandLine (show_help)
  21 import Configuration (Cfg(..), get_cfg, use_account)
  22 import LWN.Article (real_article_path)
  23 import LWN.HTTP (get_page, log_in, make_cookie_jar)
  24 import LWN.Page (epublish, parse)
  25 import LWN.XHTML (parse_lwn)
  26
  27
  28
  29 -- | Try to parse the given article using HXT. We try a few different
  30 --   methods; if none of them work, we return 'Nothing'.
  31 get_xml_from_article :: Cfg -> IO (Maybe (IOStateArrow s b XmlTree))
  32 get_xml_from_article cfg = do
  33   my_article <- real_article_path (article cfg)
  34   is_file <- doesFileExist my_article
  35   case is_file of
  36     True -> do
  37       contents <- readFile my_article
  38       return $ Just $ parse_lwn contents
  39     False -> do
  40       -- Download the URL and try to parse it.
  41       if use_account cfg then do
  42         -- use_account would be false if these fromJusts would fail.
  43         cj <- make_cookie_jar
  44         li_result <- log_in cj
  45                       (fromJust $ username cfg)
  46                       (fromJust $ password cfg)
  47
  48         case li_result of
  49           Left err -> do
  50             let msg = "Failed to log in. " ++ err
  51             hPutStrLn stderr msg
  52           Right response_body -> do
  53             hPutStrLn stderr response_body
  54
  55         html <- get_page (Just cj) my_article
  56
  57         case html of
  58           Left err -> do
  59             let msg = "Failed to retrieve page. " ++ err
  60             hPutStrLn stderr msg
  61             return Nothing
  62           Right h -> return $ Just $ parse_lwn h
  63       else do
  64         html <- get_page Nothing my_article
  65         case html of
  66           Left err -> do
  67             let msg = "Failed to retrieve page. " ++ err
  68             hPutStrLn stderr msg
  69             return Nothing
  70           Right h -> return $ Just $ parse_lwn h
  71
  72
  73 -- | If we're given an empty path, return a handle to
  74 --   'stdout'. Otherwise, open the given file and return a read/write
  75 --   handle to that.
  76 get_output_handle :: FilePath -> IO Handle
  77 get_output_handle path =
  78   if (null path) then
  79     return stdout
  80   else
  81     openBinaryFile path WriteMode
  82
  83
  84 main :: IO ()
  85 main = do
  86   cfg <- get_cfg
  87   output_handle <- get_output_handle (output cfg)
  88   maybe_html <- get_xml_from_article cfg
  89
  90   case maybe_html of
  91     Just html -> do
  92       result <- parse html
  93       case result of
  94         Just stuff  -> epublish stuff output_handle
  95         Nothing     -> do
  96          _ <- show_help
  97          return ()
  98
  99     Nothing -> do
 100       _ <- show_help
 101       return ()