{-# LANGUAGE DeriveDataTypeable #-}

module CommandLine (
  Args(..),
  apply_args,
  program_name,
  show_help )
where

-- Get the version from Cabal.
import Paths_spline3 ( version )
import Data.Version ( showVersion )

import Data.String.Utils ( startswith )
import System.Console.CmdArgs (
  CmdArgs,
  Data,
  Mode,
  Typeable,
  (&=),
  argPos,
  cmdArgsApply,
  cmdArgsMode,
  def,
  details,
  groupname,
  help,
  helpArg,
  program,
  typ,
  summary,
  versionArg )

import System.Console.CmdArgs.Explicit ( process )
import System.Environment ( getArgs, withArgs )
import System.Exit ( ExitCode(..), exitWith )
import System.IO ( hPutStrLn, stderr )

import ExitCodes ( exit_arg_parse_failed )



data Args =
  Args { depth  :: Int,
         height :: Int,
         input  :: FilePath,
         lower_threshold :: Int,
         output :: FilePath,
         scale  :: Int,
         slice  :: Maybe Int,
         upper_threshold :: Int,
         width  :: Int }
  deriving   (Show, Data, Typeable)

description :: String
description =
  "Interpolate volumetric data according to \"Local quasi-interpolation " ++
  "by cubic C^1 splines on type-6 tetrahedral partitions.\" The defaults " ++
  "are tailored to the MRI data contained in data/mri.bin from the " ++
  "Stanford volume data archive at http://graphics.stanford.edu/data/voldata/."

program_name :: String
program_name = "spline3"

spline3_summary :: String
spline3_summary =
  program_name ++ "-" ++ (showVersion version)

depth_default :: Int
depth_default = 109

depth_help :: String
depth_help =
  "The size of the z dimension (default: " ++ (show depth_default) ++ ")"

height_default :: Int
height_default = 256

height_help :: String
height_help =
  "The size of the y dimension (default: " ++ (show height_default) ++ ")"

lower_threshold_default :: Int
lower_threshold_default = 1400

lower_threshold_help :: String
lower_threshold_help =
  "The lower limit for voxel values, only used in 2D (default: " ++
  (show lower_threshold_default) ++ ")"

scale_default :: Int
scale_default = 2

scale_help :: String
scale_help =
  "The magnification scale. A scale of 2 would result " ++
  "in an image twice as large as the original. (default: " ++
  (show scale_default) ++ ")"

slice_help :: String
slice_help =
  "The index of the two-dimensional slice to use if no depth is specified"

upper_threshold_default :: Int
upper_threshold_default = 2500

upper_threshold_help :: String
upper_threshold_help =
  "The upper limit for voxel values, only used in 2D (default: " ++
  (show upper_threshold_default) ++ ")"

width_default :: Int
width_default = 256

width_help :: String
width_help =
  "The size of the x dimension (default: " ++ (show width_default) ++ ")"

arg_spec :: Mode (CmdArgs Args)
arg_spec =
  cmdArgsMode $
    Args {
      depth  = depth_default  &= groupname "Dimensions" &= help depth_help,
      height = height_default &= groupname "Dimensions" &= help height_help,
      input  = def            &= typ "INPUT"            &= argPos 0,

      lower_threshold = lower_threshold_default  &= groupname "2D options"
                                                 &= help lower_threshold_help,

      output = def            &= typ "OUTPUT"           &= argPos 1,
      scale  = scale_default  &= help scale_help,
      slice  = Nothing        &= groupname "2D options" &= help slice_help,

      upper_threshold = upper_threshold_default  &= groupname "2D options"
                                                 &= help upper_threshold_help,

      width  = width_default  &= groupname "Dimensions" &= help width_help
    }
    &= program program_name
    &= summary spline3_summary
    &= details [description]
    &= helpArg [groupname "Common flags"]
    &= versionArg [groupname "Common flags"]

-- Infix notation won't work, the arguments are backwards!
is_missing_arg_error :: String -> Bool
is_missing_arg_error =
  startswith "Requires at least"


show_help :: IO Args
show_help = withArgs ["--help"] apply_args

parse_args :: IO (CmdArgs Args)
parse_args = do
  x <- getArgs
  let y = process arg_spec x
  case y of
      Right result -> return result
      Left err ->
        if (is_missing_arg_error err) then
          -- Start this function over, pretending that --help was
          -- passed.
          withArgs ["--help"] parse_args
        else do
          hPutStrLn stderr err
          exitWith (ExitFailure exit_arg_parse_failed)


-- | Really get the command-line arguments. This calls 'parse_args'
--   first to replace the default "wrong number of arguments" error,
--   and then runs 'cmdArgsApply' on the result to do what the
--   'cmdArgs' function usually does.
apply_args :: IO Args
apply_args =
  parse_args >>= cmdArgsApply