X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Flwn-epub.git;a=blobdiff_plain;f=src%2FCommandLine.hs;fp=src%2FCommandLine.hs;h=d9be034d5f5ec5734a753ede3d791458be0c28fd;hp=0000000000000000000000000000000000000000;hb=ed2ed8abd62ba3dec7f799253de1133732f8c153;hpb=6103dbc5f8d3689e32001c3fd7627f3153e40bb0

diff --git a/src/CommandLine.hs b/src/CommandLine.hs
new file mode 100644
index 0000000..d9be034
--- /dev/null
+++ b/src/CommandLine.hs
@@ -0,0 +1,81 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module CommandLine (Args(..), apply_args)
+where
+
+-- Get the version from Cabal.
+import Paths_lwn_epub (version)
+import Data.Version (showVersion)
+
+import Data.String.Utils (startswith)
+import System.Console.CmdArgs (
+  CmdArgs,
+  Data,
+  Mode,
+  Typeable,
+  (&=),
+  argPos,
+  cmdArgsApply,
+  cmdArgsMode,
+  details,
+  program,
+  typ,
+  summary
+  )
+
+import System.Console.CmdArgs.Explicit (process)
+import System.Environment (getArgs, withArgs)
+import System.Exit (ExitCode(..), exitWith)
+import System.IO (hPutStrLn, stderr)
+
+import ExitCodes
+
+
+
+data Args =
+  Args { article :: String }
+  deriving   (Show, Data, Typeable)
+
+
+description :: String
+description = "Convert LWN articles to EPUB format."
+
+program_name :: String
+program_name = "lwn_epub"
+
+lwn_epub_summary :: String
+lwn_epub_summary =
+  program_name ++ "-" ++ (showVersion version)
+
+arg_spec :: Mode (CmdArgs Args)
+arg_spec = cmdArgsMode $
+             Args { article = "" &= argPos 0 &= typ "ARTICLE" }
+             &= program program_name
+             &= summary lwn_epub_summary
+             &= details [description]
+
+
+-- Infix notation won't work, the arguments are backwards!
+is_missing_arg_error :: String -> Bool
+is_missing_arg_error s =
+  startswith "Requires at least" s
+
+parse_args :: IO (CmdArgs Args)
+parse_args = do
+  x <- getArgs
+  let y = process arg_spec x
+  case y of
+      Right result -> return result
+      Left err ->
+        if (is_missing_arg_error err) then
+          withArgs ["--help"] parse_args
+        else do
+          hPutStrLn stderr err
+          exitWith (ExitFailure exit_args_parse_failed)
+
+        -- Disregard the error message, show help instead.
+
+apply_args :: IO Args
+apply_args = do
+  x <- parse_args
+  cmdArgsApply x