base == 4.5.*,
bytestring == 0.9.*,
cmdargs == 0.9.*,
+ ConfigFile == 1.*,
containers == 0.*,
curl == 1.*,
directory == 1.1.*,
{-# LANGUAGE DeriveDataTypeable #-}
-module CommandLine (Args(..), apply_args, show_help)
+module CommandLine (
+ Args(..),
+ apply_args,
+ program_name,
+ show_help)
where
-- Get the version from Cabal.
--- /dev/null
+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
-- |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
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)
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
remove_comment_links =
processTopDown $ kill_comments `when` is_link
where
- contains = isInfixOf
-
is_comment_link =
hasAttrValue "href" (contains "#Comments")
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.
where
import Prelude hiding (readFile)
-import System.Directory(doesFileExist)
+import System.Directory (doesFileExist)
import System.IO (
Handle,
IOMode (WriteMode),
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
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
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
projects / dead / lwn-epub.git / commitdiff