Add a CommandLine module for parsing command-line options.

[hath.git] / src / CommandLine.hs

diff --git a/src/CommandLine.hs b/src/CommandLine.hs
new file mode 100644 (file)
index 0000000..eba70db
--- /dev/null
+++ b/src/CommandLine.hs
@@ -0,0 +1,98 @@
+-- The CommandLine module handles parsing of the command-line options.
+-- It should more or less be a black box, providing Main with only the
+-- information it requires.
+
+module CommandLine
+( help_set,
+  help_text,
+  input_function,
+  parse_errors
+) where
+
+import System.Console.GetOpt
+import System.Environment (getArgs)
+
+
+-- A record containing values for all available options.
+data Options = Options { opt_help  :: Bool,
+                         opt_input :: IO String }
+
+-- This constructs an instance of Options, with each of its members
+-- set to default values.
+default_options :: Options
+default_options = Options { opt_help = False,
+                            opt_input = getContents }
+
+
+-- The options list that we construct associates a function with each
+-- option. This function is responsible for updating an Options record
+-- with the appropriate value.
+--
+-- For more information and an example of this idiom, see,
+--
+-- http://www.haskell.org/haskellwiki/High-level_option_handling_with_GetOpt
+--
+options :: [OptDescr (Options -> IO Options)]
+options =
+  [ Option ['h'][] (NoArg set_help) "Prints this help message.",
+    Option ['i'][] (ReqArg set_input "FILE") "Read FILE instead of stdin." ]
+
+-- Takes an Options as an argument, and sets its opt_help member to
+-- True.
+set_help :: Options -> IO Options
+set_help opts = do
+  return opts { opt_help = True }
+
+-- If the input file option is set, this function will update the
+-- passed Options record with a new function for opt_input. The
+-- default opt_input is to read from stdin, but if this option is set,
+-- we replace that with readFile.
+set_input :: String -> Options -> IO Options
+set_input arg opts = do
+  return opts { opt_input = readFile arg }
+
+-- The usage header
+usage :: String
+usage = "Usage: hath [-h] [-i FILE]"
+
+
+-- The usage header, and all available flags (as generated by GetOpt)
+help_text :: String
+help_text = usageInfo usage options
+
+
+-- Return a tuple of options and errors.
+parse_options :: IO (Options, [String])
+parse_options = do
+  argv <- getArgs
+  let (actions, _, errors) = getOpt Permute options argv
+
+  -- This will execute each of the functions contained in our options
+  -- list, one after another, on a default_options record. The end
+  -- result should be an Options instance with all of its members set
+  -- correctly.
+  opts <- foldl (>>=) (return default_options) actions
+
+  return (opts, errors)
+
+
+-- Return just the errors from parse_options.
+parse_errors :: IO [String]
+parse_errors = do
+    (_, errors) <- parse_options
+    return errors
+
+
+-- Is the help option set?
+help_set :: IO Bool
+help_set = do
+    (opts, _) <- parse_options
+    return (opt_help opts)
+
+
+-- Return our input function, getContents by default, or readFile if
+-- the input file option was set.
+input_function :: IO (IO String)
+input_function = do
+    (opts, _) <- parse_options
+    return (opt_input opts)