src/CommandLine.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2
   3 module CommandLine (
   4   Args(..),
   5   apply_args,
   6   program_name,
   7   show_help)
   8 where
   9
  10 -- Get the version from Cabal.
  11 import Paths_spline3 (version)
  12 import Data.Version (showVersion)
  13
  14 import Data.String.Utils (startswith)
  15 import System.Console.CmdArgs (
  16   CmdArgs,
  17   Data,
  18   Mode,
  19   Typeable,
  20   (&=),
  21   argPos,
  22   cmdArgsApply,
  23   cmdArgsMode,
  24   def,
  25   details,
  26   groupname,
  27   help,
  28   helpArg,
  29   program,
  30   typ,
  31   summary,
  32   versionArg
  33   )
  34
  35 import System.Console.CmdArgs.Explicit (process)
  36 import System.Environment (getArgs, withArgs)
  37 import System.Exit (ExitCode(..), exitWith)
  38 import System.IO (hPutStrLn, stderr)
  39
  40 import ExitCodes
  41
  42
  43
  44 data Args =
  45   Args { depth  :: Int,
  46          height :: Int,
  47          input  :: FilePath,
  48          scale  :: Int,
  49          slice  :: Maybe Int,
  50          output :: FilePath,
  51          width  :: Int }
  52   deriving   (Show, Data, Typeable)
  53
  54 description :: String
  55 description =
  56   "Interpolate volumetric data according to \"Local quasi-interpolation " ++
  57   "by cubic C^1 splines on type-6 tetrahedral partitions.\" The defaults " ++
  58   "are tailored to the MRI data contained in data/mri.bin from the " ++
  59   "Stanford volume data archive at http://graphics.stanford.edu/data/voldata/."
  60
  61 program_name :: String
  62 program_name = "spline3"
  63
  64 spline3_summary :: String
  65 spline3_summary =
  66   program_name ++ "-" ++ (showVersion version)
  67
  68 depth_help :: String
  69 depth_help = "The size of the z dimension (default: 109)"
  70
  71 height_help :: String
  72 height_help = "The size of the y dimension (default: 256)"
  73
  74 scale_help :: String
  75 scale_help =
  76   "The magnification scale. A scale of 2 would result " ++
  77   "in an image twice as large as the original. (default: 2)"
  78
  79 slice_help :: String
  80 slice_help =
  81   "The index of the two-dimensional slice to use if no depth is specified"
  82
  83 width_help :: String
  84 width_help = "The size of the x dimension (default: 256)"
  85
  86 arg_spec :: Mode (CmdArgs Args)
  87 arg_spec =
  88   cmdArgsMode $
  89     Args {
  90       depth  = 109     &= groupname "Dimensions" &= help depth_help,
  91       height = 256     &= groupname "Dimensions" &= help height_help,
  92       input  = def     &= typ "INPUT"            &= argPos 0,
  93       output = def     &= typ "OUTPUT"           &= argPos 1,
  94       scale  = 2                                 &= help scale_help,
  95       slice  = Nothing &= groupname "2D options" &= help slice_help,
  96       width  = 256     &= groupname "Dimensions" &= help width_help
  97     }
  98     &= program program_name
  99     &= summary spline3_summary
 100     &= details [description]
 101     &= helpArg [groupname "Common flags"]
 102     &= versionArg [groupname "Common flags"]
 103
 104 -- Infix notation won't work, the arguments are backwards!
 105 is_missing_arg_error :: String -> Bool
 106 is_missing_arg_error s =
 107   startswith "Requires at least" s
 108
 109
 110 show_help :: IO Args
 111 show_help = withArgs ["--help"] apply_args
 112
 113 parse_args :: IO (CmdArgs Args)
 114 parse_args = do
 115   x <- getArgs
 116   let y = process arg_spec x
 117   case y of
 118       Right result -> return result
 119       Left err ->
 120         if (is_missing_arg_error err) then
 121           -- Start this function over, pretending that --help was
 122           -- passed.
 123           withArgs ["--help"] parse_args
 124         else do
 125           hPutStrLn stderr err
 126           exitWith (ExitFailure exit_arg_parse_failed)
 127
 128
 129 -- | Really get the command-line arguments. This calls 'parse_args'
 130 --   first to replace the default "wrong number of arguments" error,
 131 --   and then runs 'cmdArgsApply' on the result to do what the
 132 --   'cmdArgs' function usually does.
 133 apply_args :: IO Args
 134 apply_args =
 135   parse_args >>= cmdArgsApply