Add a --full-stories option which may or may not work.
[dead/lwn-epub.git] / src / CommandLine.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2
3 module CommandLine (
4 Args(..),
5 apply_args,
6 program_name,
7 show_help)
8 where
9
10 -- Get the version from Cabal.
11 import Paths_lwn_epub (version)
12 import Data.Version (showVersion)
13
14 import Data.String.Utils (startswith)
15 import System.Console.CmdArgs (
16 CmdArgs,
17 Data,
18 Mode,
19 Typeable,
20 (&=),
21 argPos,
22 cmdArgsApply,
23 cmdArgsMode,
24 def,
25 details,
26 help,
27 program,
28 typ,
29 typFile,
30 summary
31 )
32
33 import System.Console.CmdArgs.Explicit (process)
34 import System.Environment (getArgs, withArgs)
35 import System.Exit (ExitCode(..), exitWith)
36 import System.IO (hPutStrLn, stderr)
37
38 import ExitCodes
39
40
41
42 data Args =
43 Args { full_stories :: Bool,
44 output :: FilePath,
45 article :: String }
46 deriving (Show, Data, Typeable)
47
48
49 description :: String
50 description = "Convert LWN articles to EPUB format."
51
52 program_name :: String
53 program_name = "lwn-epub"
54
55 lwn_epub_summary :: String
56 lwn_epub_summary =
57 program_name ++ "-" ++ (showVersion version)
58
59 output_help :: String
60 output_help = "Output file, defaults to stdout"
61
62 full_stories_help :: String
63 full_stories_help = "Replace \"Full Story\" links with their content"
64
65 arg_spec :: Mode (CmdArgs Args)
66 arg_spec = cmdArgsMode $
67 Args {
68 full_stories = def &= help full_stories_help,
69 output = def &= typFile &= help output_help,
70 article = def &= argPos 0 &= typ "ARTICLE"
71 }
72 &= program program_name
73 &= summary lwn_epub_summary
74 &= details [description]
75
76
77 -- Infix notation won't work, the arguments are backwards!
78 is_missing_arg_error :: String -> Bool
79 is_missing_arg_error s =
80 startswith "Requires at least" s
81
82
83 show_help :: IO (CmdArgs Args)
84 show_help = withArgs ["--help"] parse_args
85
86 parse_args :: IO (CmdArgs Args)
87 parse_args = do
88 x <- getArgs
89 let y = process arg_spec x
90 case y of
91 Right result -> return result
92 Left err ->
93 if (is_missing_arg_error err) then
94 -- Disregard the error message, show help instead.
95 show_help
96 else do
97 hPutStrLn stderr err
98 exitWith (ExitFailure exit_args_parse_failed)
99
100
101 -- | Really get the command-line arguments. This calls 'parse_args'
102 -- first to replace the default "wrong number of arguments" error,
103 -- and then runs 'cmdArgsApply' on the result to do what the
104 -- 'cmdArgs' function usually does.
105 apply_args :: IO Args
106 apply_args =
107 parse_args >>= cmdArgsApply