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?