Add config file parsing.
authorMichael Orlitzky <michael@orlitzky.com>
Thu, 28 Jun 2012 01:16:39 +0000 (21:16 -0400)
committerMichael Orlitzky <michael@orlitzky.com>
Thu, 28 Jun 2012 01:16:39 +0000 (21:16 -0400)
lwn-epub.cabal
src/CommandLine.hs
src/Configuration.hs [new file with mode: 0644]
src/ExitCodes.hs
src/LWN/Page.hs
src/LWN/URI.hs
src/Main.hs
src/Misc.hs

index c374d8d201cc3ad096e36ae1efc5f9d41af6d507..c9a505c72061d710fea3cf076961698154bfefb7 100644 (file)
@@ -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.*,
index 4fd9a542d600e8a41c9c74498ccd153fda013a7c..455f7fd7a9416f0e417829ae9f6cad1020670c41 100644 (file)
@@ -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 (file)
index 0000000..457480a
--- /dev/null
@@ -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
index 11c03f9b67a7e53cff4bfbd2a71a1e7df4971512..9d4049bfe3fc0d58f4f04ac1a7523d85a5534e7f 100644 (file)
@@ -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
index 0307214176a82c469f1f555a056b553c05bd3b06..7419402a3af304974dac87236826b4fcd8f545ae 100644 (file)
@@ -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")
 
index 9e7c7d944963a0a52b51b2b6b48aeb48ef57373d..1cf88263f5a627ecb5851bc6531858fe1b257f3f 100644 (file)
@@ -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.
index 8ab82b94409e25b28d2856dc9b7d6482c304d164..47c69fa1cba9ade063d2b63bea22fe800b33a4e9 100644 (file)
@@ -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
 
index bec8917c58dcaafc5b3de63fd331e75a23228a13..dfcd40be3d1ba487b747ee82ee4d834ad4a106b8 100644 (file)
@@ -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