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   (&=),
  20   argPos,
  21   cmdArgsApply,
  22   cmdArgsMode,
  23   def,
  24   details,
  25   groupname,
  26   help,
  27   helpArg,
  28   program,
  29   typ,
  30   summary,
  31   versionArg )
  32
  33 import System.Console.CmdArgs.Explicit ( process )
  34 import System.Environment ( getArgs, withArgs )
  35 import System.Exit ( ExitCode(..), exitWith )
  36 import System.IO ( hPutStrLn, stderr )
  37
  38 import ExitCodes ( exit_arg_parse_failed )
  39
  40
  41
  42 data Args =
  43   Args { depth  :: Int,
  44          height :: Int,
  45          input  :: FilePath,
  46          lower_threshold :: Int,
  47          output :: FilePath,
  48          scale  :: Int,
  49          slice  :: Maybe Int,
  50          upper_threshold :: Int,
  51          width  :: Int }
  52   deriving   (Show, Data)
  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_default :: Int
  69 depth_default = 109
  70
  71 depth_help :: String
  72 depth_help =
  73   "The size of the z dimension (default: " ++ (show depth_default) ++ ")"
  74
  75 height_default :: Int
  76 height_default = 256
  77
  78 height_help :: String
  79 height_help =
  80   "The size of the y dimension (default: " ++ (show height_default) ++ ")"
  81
  82 lower_threshold_default :: Int
  83 lower_threshold_default = 1400
  84
  85 lower_threshold_help :: String
  86 lower_threshold_help =
  87   "The lower limit for voxel values, only used in 2D (default: " ++
  88   (show lower_threshold_default) ++ ")"
  89
  90 scale_default :: Int
  91 scale_default = 2
  92
  93 scale_help :: String
  94 scale_help =
  95   "The magnification scale. A scale of 2 would result " ++
  96   "in an image twice as large as the original. (default: " ++
  97   (show scale_default) ++ ")"
  98
  99 slice_help :: String
 100 slice_help =
 101   "The index of the two-dimensional slice to use if no depth is specified"
 102
 103 upper_threshold_default :: Int
 104 upper_threshold_default = 2500
 105
 106 upper_threshold_help :: String
 107 upper_threshold_help =
 108   "The upper limit for voxel values, only used in 2D (default: " ++
 109   (show upper_threshold_default) ++ ")"
 110
 111 width_default :: Int
 112 width_default = 256
 113
 114 width_help :: String
 115 width_help =
 116   "The size of the x dimension (default: " ++ (show width_default) ++ ")"
 117
 118 arg_spec :: Mode (CmdArgs Args)
 119 arg_spec =
 120   cmdArgsMode $
 121     Args {
 122       depth  = depth_default  &= groupname "Dimensions" &= help depth_help,
 123       height = height_default &= groupname "Dimensions" &= help height_help,
 124       input  = def            &= typ "INPUT"            &= argPos 0,
 125
 126       lower_threshold = lower_threshold_default  &= groupname "2D options"
 127                                                  &= help lower_threshold_help,
 128
 129       output = def            &= typ "OUTPUT"           &= argPos 1,
 130       scale  = scale_default  &= help scale_help,
 131       slice  = Nothing        &= groupname "2D options" &= help slice_help,
 132
 133       upper_threshold = upper_threshold_default  &= groupname "2D options"
 134                                                  &= help upper_threshold_help,
 135
 136       width  = width_default  &= groupname "Dimensions" &= help width_help
 137     }
 138     &= program program_name
 139     &= summary spline3_summary
 140     &= details [description]
 141     &= helpArg [groupname "Common flags"]
 142     &= versionArg [groupname "Common flags"]
 143
 144 -- Infix notation won't work, the arguments are backwards!
 145 is_missing_arg_error :: String -> Bool
 146 is_missing_arg_error =
 147   startswith "Requires at least"
 148
 149
 150 show_help :: IO Args
 151 show_help = withArgs ["--help"] apply_args
 152
 153 parse_args :: IO (CmdArgs Args)
 154 parse_args = do
 155   x <- getArgs
 156   let y = process arg_spec x
 157   case y of
 158       Right result -> return result
 159       Left err ->
 160         if (is_missing_arg_error err) then
 161           -- Start this function over, pretending that --help was
 162           -- passed.
 163           withArgs ["--help"] parse_args
 164         else do
 165           hPutStrLn stderr err
 166           exitWith (ExitFailure exit_arg_parse_failed)
 167
 168
 169 -- | Really get the command-line arguments. This calls 'parse_args'
 170 --   first to replace the default "wrong number of arguments" error,
 171 --   and then runs 'cmdArgsApply' on the result to do what the
 172 --   'cmdArgs' function usually does.
 173 apply_args :: IO Args
 174 apply_args =
 175   parse_args >>= cmdArgsApply