From ebedcdb6b1b8925dcfb5700d076f25743fac8645 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Wed, 27 Jun 2012 21:16:39 -0400 Subject: [PATCH] Add config file parsing. --- lwn-epub.cabal | 1 + src/CommandLine.hs | 6 ++- src/Configuration.hs | 123 +++++++++++++++++++++++++++++++++++++++++++ src/ExitCodes.hs | 4 ++ src/LWN/Page.hs | 4 +- src/LWN/URI.hs | 2 +- src/Main.hs | 31 +++++++++-- src/Misc.hs | 19 ++----- 8 files changed, 166 insertions(+), 24 deletions(-) create mode 100644 src/Configuration.hs diff --git a/lwn-epub.cabal b/lwn-epub.cabal index c374d8d..c9a505c 100644 --- a/lwn-epub.cabal +++ b/lwn-epub.cabal @@ -12,6 +12,7 @@ executable lwn-epub base == 4.5.*, bytestring == 0.9.*, cmdargs == 0.9.*, + ConfigFile == 1.*, containers == 0.*, curl == 1.*, directory == 1.1.*, diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 4fd9a54..455f7fd 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -1,6 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-} -module CommandLine (Args(..), apply_args, show_help) +module CommandLine ( + Args(..), + apply_args, + program_name, + show_help) where -- Get the version from Cabal. diff --git a/src/Configuration.hs b/src/Configuration.hs new file mode 100644 index 0000000..457480a --- /dev/null +++ b/src/Configuration.hs @@ -0,0 +1,123 @@ +module Configuration ( + Cfg(..), + get_cfg + ) +where + +import Control.Monad (mplus) +import Data.ConfigFile +import Data.Maybe (isJust) +import Data.Monoid (Monoid(..)) +import System.Directory ( + getAppUserDataDirectory + ) +import System.Exit (ExitCode(..), exitWith) +import System.FilePath.Posix (joinPath) +import System.IO (hPutStrLn, stderr) + +import qualified CommandLine as Cmd ( + Args(..), + apply_args, + program_name + ) +import ExitCodes + +-- | Contains all of our configurable options. +data Cfg = Cfg { + article :: String, + output :: FilePath, + password :: Maybe String, + username :: Maybe String } + + +instance Monoid Cfg where + mempty = Cfg { article = "", + output = "", + password = Nothing, + username = Nothing } + + mappend c1 c2 = + let article' = (if null article1 then article2 else article1) + output' = (if null output1 then output2 else output1) + password' = password1 `mplus` password2 + username' = username1 `mplus` username2 + in + Cfg { article = article', + output = output', + password = password', + username = username' } + where + article1 = article c1 + article2 = article c2 + output1 = output c1 + output2 = output c2 + password1 = password c1 + password2 = password c2 + username1 = username c1 + username2 = username c2 + + +use_account :: Cfg -> Bool +use_account cfg = + (isJust $ username cfg) && (isJust $ password cfg) + +format_cpe :: CPError -> String +format_cpe (ParseError desc, _) = "Parse error: " ++ desc +format_cpe (SectionAlreadyExists desc, _) = "Section already exists: " ++ desc +format_cpe (NoSection desc, _) = "Missing section: " ++ desc +format_cpe (NoOption desc, _) = "Missing required option: " ++ desc +format_cpe (OtherProblem desc, _) = "Error: " ++ desc +format_cpe (InterpolationError desc, _) = "Interpolation error: " ++ desc + + +-- | The config parsing functions return either the result or a +-- 'CPError'. If there was an error, we represent it as 'Nothing' +-- (at least if we're forcing the value into a 'Maybe' +-- wrapper. Otherwise, we return 'Just' the result. +either_to_maybe :: Either CPError a -> Maybe a +either_to_maybe (Left _) = Nothing +either_to_maybe (Right x) = Just x + + +config_filename :: String +config_filename = Cmd.program_name ++ ".conf" + +config_path :: IO FilePath +config_path = do + cfg_dir <- getAppUserDataDirectory Cmd.program_name + return $ joinPath [cfg_dir, config_filename] + +parse_config :: IO (Either String Cfg) +parse_config = do + cfg_file <- config_path + parse_result <- readfile emptyCP cfg_file + + return $ + case parse_result of + Left err -> Left (format_cpe err) + Right cp -> + let cp_username = get cp "DEFAULT" "username" + cp_password = get cp "DEFAULT" "password" + + cfg_username = either_to_maybe cp_username + cfg_password = either_to_maybe cp_password + in + Right $ mempty { username = cfg_username, + password = cfg_password } + + + +get_cfg :: IO Cfg +get_cfg = do + cmd_article <- Cmd.apply_args + let arg_cfg = mempty { article = Cmd.article cmd_article, + output = Cmd.output cmd_article } + + either_file_cfg <- parse_config + case either_file_cfg of + Left err -> do + hPutStrLn stderr err + exitWith $ ExitFailure exit_config_parse_failed + Right file_cfg -> + -- The left operand takes precedence when both are non-empty! + return $ arg_cfg `mappend` file_cfg diff --git a/src/ExitCodes.hs b/src/ExitCodes.hs index 11c03f9..9d4049b 100644 --- a/src/ExitCodes.hs +++ b/src/ExitCodes.hs @@ -7,3 +7,7 @@ where -- |Indicates that the command-line arguments could not be parsed. exit_args_parse_failed :: Int exit_args_parse_failed = 1 + +-- |Indicates that the command-line arguments could not be parsed. +exit_config_parse_failed :: Int +exit_config_parse_failed = 2 diff --git a/src/LWN/Page.hs b/src/LWN/Page.hs index 0307214..7419402 100644 --- a/src/LWN/Page.hs +++ b/src/LWN/Page.hs @@ -7,7 +7,6 @@ import qualified Data.Map as Map import Data.Time (getCurrentTime) import System.IO (Handle) import qualified Data.ByteString.Lazy as B (ByteString, hPut) -import Data.List (isInfixOf) import Data.String.Utils (split, strip) import Data.Maybe (catMaybes, fromJust, isNothing) import Data.Tree.NTree.TypeDefs (NTree) @@ -44,6 +43,7 @@ import Text.HandsomeSoup (css, parseHtml) import LWN.Article import LWN.HTTP (save_image) import LWN.URI (URL, try_make_absolute_url) +import Misc (contains) import XHTML -- Map absolute image URLs to local system file paths where the image @@ -121,8 +121,6 @@ remove_comment_links :: (ArrowXml a) => a XmlTree XmlTree remove_comment_links = processTopDown $ kill_comments `when` is_link where - contains = isInfixOf - is_comment_link = hasAttrValue "href" (contains "#Comments") diff --git a/src/LWN/URI.hs b/src/LWN/URI.hs index 9e7c7d9..1cf8826 100644 --- a/src/LWN/URI.hs +++ b/src/LWN/URI.hs @@ -14,7 +14,7 @@ import Network.URI ( import Test.HUnit (Assertion, assertEqual) import Test.Framework (Test, testGroup) import Test.Framework.Providers.HUnit (testCase) -import Text.Regex.Posix +import Text.Regex.Posix ((=~)) -- Distinguish between URLs (Strings) and URIs as provided by the -- Network.URI module. diff --git a/src/Main.hs b/src/Main.hs index 8ab82b9..47c69fa 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -3,7 +3,7 @@ module Main where import Prelude hiding (readFile) -import System.Directory(doesFileExist) +import System.Directory (doesFileExist) import System.IO ( Handle, IOMode (WriteMode), @@ -11,10 +11,14 @@ import System.IO ( stdout ) import System.IO.UTF8 (readFile) +import Text.Regex.Posix ((=~)) import Text.XML.HXT.Core -import CommandLine (Args(..), apply_args, show_help) +import CommandLine (show_help) +import Configuration (Cfg(..), get_cfg) import LWN.Page +import LWN.URI (is_lwn_url, make_absolute_url) +import Misc (contains) my_read_opts :: SysConfigList @@ -51,17 +55,36 @@ get_output_handle path = openBinaryFile path WriteMode + -- | Convert the given article to either a URL or a filesystem -- path. If the given article exists on the filesystem, we assume -- it's a file. Otherwise, we check to see if it's a URL. Failing -- that, we try to construct a URL from what we're given and do our -- best. real_article_path :: String -> IO String -real_article_path = return . id +real_article_path s = do + is_file <- doesFileExist s + return $ if is_file then s else check_cases + where + abs_current = + case make_absolute_url "current" of + Nothing -> s + Just ac -> ac + abs_s = + case make_absolute_url s of + Nothing -> s + Just as -> as + + check_cases :: String + check_cases + | is_lwn_url s = s + | s `contains` "current" = abs_current + | s =~ "^[0-9]+$" = abs_s + | otherwise = s -- Give up main :: IO () main = do - Args{..} <- apply_args + Cfg{..} <- get_cfg output_handle <- get_output_handle output maybe_html <- get_xml_from_article article diff --git a/src/Misc.hs b/src/Misc.hs index bec8917..dfcd40b 100644 --- a/src/Misc.hs +++ b/src/Misc.hs @@ -1,19 +1,8 @@ module Misc where -import qualified Data.ByteString.Lazy as B (ByteString, readFile) -import System.Directory (getTemporaryDirectory, removeFile) -import System.IO (hClose, hPutStr, hSetEncoding, openTempFile, utf8) +import Data.List (isInfixOf) --- | Run a 'String' through the filesystem to convert it to a --- 'ByteString' in the stupidest way possible. -string_to_bytestring :: String -> IO B.ByteString -string_to_bytestring s = do - dir <- getTemporaryDirectory - (path, h) <- openTempFile dir "nu1Uideehe" - hSetEncoding h utf8 - hPutStr h s - hClose h - result <- B.readFile path - removeFile path - return result +-- | Specializes Data.List.isInfixOf. +contains :: String -> String -> Bool +contains = isInfixOf \ No newline at end of file -- 2.43.2