src/CommandLine.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2
   3 module CommandLine (Args(..), apply_args)
   4 where
   5
   6 -- Get the version from Cabal.
   7 import Paths_lwn_epub (version)
   8 import Data.Version (showVersion)
   9
  10 import Data.String.Utils (startswith)
  11 import System.Console.CmdArgs (
  12   CmdArgs,
  13   Data,
  14   Mode,
  15   Typeable,
  16   (&=),
  17   argPos,
  18   cmdArgsApply,
  19   cmdArgsMode,
  20   details,
  21   program,
  22   typ,
  23   summary
  24   )
  25
  26 import System.Console.CmdArgs.Explicit (process)
  27 import System.Environment (getArgs, withArgs)
  28 import System.Exit (ExitCode(..), exitWith)
  29 import System.IO (hPutStrLn, stderr)
  30
  31 import ExitCodes
  32
  33
  34
  35 data Args =
  36   Args { article :: String }
  37   deriving   (Show, Data, Typeable)
  38
  39
  40 description :: String
  41 description = "Convert LWN articles to EPUB format."
  42
  43 program_name :: String
  44 program_name = "lwn_epub"
  45
  46 lwn_epub_summary :: String
  47 lwn_epub_summary =
  48   program_name ++ "-" ++ (showVersion version)
  49
  50 arg_spec :: Mode (CmdArgs Args)
  51 arg_spec = cmdArgsMode $
  52              Args { article = "" &= argPos 0 &= typ "ARTICLE" }
  53              &= program program_name
  54              &= summary lwn_epub_summary
  55              &= details [description]
  56
  57
  58 -- Infix notation won't work, the arguments are backwards!
  59 is_missing_arg_error :: String -> Bool
  60 is_missing_arg_error s =
  61   startswith "Requires at least" s
  62
  63 parse_args :: IO (CmdArgs Args)
  64 parse_args = do
  65   x <- getArgs
  66   let y = process arg_spec x
  67   case y of
  68       Right result -> return result
  69       Left err ->
  70         if (is_missing_arg_error err) then
  71           withArgs ["--help"] parse_args
  72         else do
  73           hPutStrLn stderr err
  74           exitWith (ExitFailure exit_args_parse_failed)
  75
  76         -- Disregard the error message, show help instead.
  77
  78 apply_args :: IO Args
  79 apply_args = do
  80   x <- parse_args
  81   cmdArgsApply x