Parsing command line arguments in Haskell using getOpt - getopt

Question

I am trying to teach myself Haskell. As a sample program, I am writing a Spider solitaire player.
I am trying to write a command line parser using System.Console.GetOpt. I know there are easier ways to do argument parsing for this program, but I want to learn how to use the GetOpt module because I anticipate needing its sophistication later in other programs that I will be writing.
I am trying to add a "--help" option that just prints a usage message and then exits. I would also like to print usage messages if either of the arguments to the "--games" option or the "--suits" option are not valid integers (games >= 1 and <= 1000, suits == 1, 2, or 4). I will be passing the resulting Options data type to other parts of my program.
I am also getting an error that progName is not in scope. Isn't the case statement in parseArgs in the scope of the do block?
Here is my code, patched together from the examples in "Real World Haskell" and the Haskell wiki:
module Main (main) where
import System.Console.GetOpt
import System.Environment(getArgs, getProgName)
data Options = Options {
optGames :: Int
, optSuits :: Int
, optVerbose :: Bool
} deriving Show
defaultOptions = Options {
optGames = 1
, optSuits = 4
, optVerbose = False
}
options :: [OptDescr (Options -> Options)]
options =
[ Option ['g'] ["games"]
(ReqArg (\g opts -> opts { optGames = (read g) }) "GAMES")
"number of games"
, Option ['s'] ["suits"]
(ReqArg (\s opts -> opts { optSuits = (read s) }) "SUITS")
"number of suits"
, Option ['v'] ["verbose"]
(NoArg (\opts -> opts { optVerbose = True }))
"verbose output"
]
parseArgs :: IO Options
parseArgs = do
argv <- getArgs
progName <- getProgName
case getOpt RequireOrder options argv of
(opts, [], []) -> return (foldl (flip id) defaultOptions opts)
(_, _, errs) -> ioError (userError (concat errs ++ helpMessage))
where
header = "Usage: " ++ progName ++ " [OPTION...]"
helpMessage = usageInfo header options
main :: IO ()
main = do
options <- parseArgs
putStrLn $ show options

Answer 1

Here is the solution that I came up with:
module Main (main) where
import Control.Monad
import Control.Monad.Error
import System.Console.GetOpt
import System.Environment(getArgs, getProgName)
data Options = Options {
optGames :: Int
, optSuits :: Int
, optVerbose :: Bool
} deriving Show
defaultOptions = Options {
optGames = 1
, optSuits = 4
, optVerbose = False
}
options :: [OptDescr (Options -> Either String Options)]
options =
[ Option ['g'] ["games"]
(ReqArg (\g opts ->
case reads g of
[(games, "")] | games >= 1 && games <= 1000 -> Right opts { optGames = games }
_ -> Left "--games must be a number between 1 and 1000"
) "GAMES")
"number of games"
, Option ['s'] ["suits"]
(ReqArg (\s opts ->
case reads s of
[(suits, "")] | suits `elem` [1, 2, 4] -> Right opts { optSuits = suits }
_ -> Left "--suits must be 1, 2, or 4"
) "SUITS")
"number of suits"
, Option ['v'] ["verbose"]
(NoArg (\opts -> Right opts { optVerbose = True }))
"verbose output"
]
parseArgs :: IO Options
parseArgs = do
argv <- getArgs
progName <- getProgName
let header = "Usage: " ++ progName ++ " [OPTION...]"
let helpMessage = usageInfo header options
case getOpt RequireOrder options argv of
(opts, [], []) ->
case foldM (flip id) defaultOptions opts of
Right opts -> return opts
Left errorMessage -> ioError (userError (errorMessage ++ "\n" ++ helpMessage))
(_, _, errs) -> ioError (userError (concat errs ++ helpMessage))
main :: IO ()
main = do
options <- parseArgs
putStrLn $ show options
How can I improve this?