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