program gray_convert

  use gray_cli,    only: print_version, get_next_command
  use gray_params, only: gray_parameters, read_gray_params, read_gray_config, &
                         step_enum, absorption_enum, current_drive_enum,      &
                         polar_enum, beam_enum, equil_enum, x_point_enum,     &
                         scaling_enum, rho_enum, profiles_enum
  implicit none

  ! Configuration formats
  enum, bind(c)
    enumerator :: config_format = -1
    enumerator :: FORMAT_PARAMS = 1 ! the legacy gray_params.data format
    enumerator :: FORMAT_INI    = 2 ! the current INI format
  end enum

  ! Command line options
  ! See print_help() for a description.
  type cli_options
    character(len=:), allocatable :: input_file   ! file to read
    character(len=:), allocatable :: output_file  ! file to write
    integer(kind(config_format))  :: format       ! output file format
  end type

  no_save: block

  type(cli_options) :: opts
  type(gray_parameters) :: params
  integer :: err

  call parse_cli_options(opts)

  ! Reading
  if (index(opts%input_file, ".data") /= 0) &
    call read_gray_params(opts%input_file, params, err)
  if (index(opts%input_file, ".ini") /= 0) &
    call read_gray_config(opts%input_file, params, err)

  if (err /= 0) call exit(2)

  ! Writing
  select case (opts%format)
    case (FORMAT_PARAMS)
      print '(a)', 'gray_params.data output not implemented!'
      call exit(1)
    case (FORMAT_INI)
      call write_gray_config(opts%output_file, params)
  end select

  call exit(0)

  end block no_save

contains

  subroutine print_help()
    ! Prints the usage screen

    print '(a)', 'Usage: gray-convert [options] INFILE OUTFILE'
    print '(a)', ''
    print '(a)', 'Converts between different GRAY configuration formats.'
    print '(a)', ''
    print '(a)', 'Options:'
    print '(a)', '  -h, --help                display this help and exit'
    print '(a)', '  -V, --version             display version information and exit'
    print '(a)', '  -f, --format              set the output file format (default: ini)'
    print '(a)', '                            valid formats are: `ini`, `params`.'
    print '(a)', ''
    print '(a)', '*Exit status*'
    print '(a)', ' 0  if OK,'
    print '(a)', ' 1  if technical problems   (e.g., invalid arguments, missing input files),'
    print '(a)', ' 2  if serious trouble      (e.g., invalid input file).'
  end subroutine

  subroutine parse_cli_options(opts)
    ! Parses the CLI arguments and initialise the options

    ! subroutine arguments
    type(cli_options), intent(out) :: opts

    ! local variables
    character(len=:), allocatable :: argument
    integer :: i, nargs

    ! Default option values
    opts%format = FORMAT_INI

    nargs = command_argument_count()
    i = 1

    do
      if (i > nargs) exit
      call get_next_command(i, argument)

      ! parse an argument (and possibly a value)
      select case (argument)
        ! parse optional arguments
        case ('-h', '--help')
          call print_help()
          deallocate(argument)
          call exit(0)

        case ('-V', '--version')
          call print_version()
          deallocate(argument)
          call exit(0)

        case ('-f', '--format')
          call get_next_command(i, argument)
          select case (argument)
            case ('params')
              opts%format = FORMAT_PARAMS
            case ('ini')
              opts%format = FORMAT_INI
            case default
              print '(a)', 'unknown format: ', argument
          end select

        case default
          ! read positional arguments
          if (i - nargs == 0) then
            opts%input_file = argument
            cycle
          else if (i - nargs == 1) then
            opts%output_file = argument
            cycle
          end if

          print '(a,a,/)', 'Unknown option: ', argument
          call print_help()
          deallocate(argument)
          call exit(1)

      end select
    end do

    ! free temporary string
    if (nargs > 0) deallocate(argument)
  end subroutine

  subroutine write_gray_config(filename, params)
    ! Generates a gray.ini configuration file

    ! subroutine arguments
    character(len=*),       intent(in) :: filename
    type(gray_parameters),  intent(in) :: params

    ! local variables
    type(gray_parameters) :: defaults
    character(*), parameter :: fmt = '(a, " = ", g0.6)'
    integer :: err, u

    open(u, file=filename, action='write', iostat=err)
    if (err /= 0) then
      print '("opening output file (",a,") failed!")', filename
      return
    end if

    write(u, '(a)') "[raytracing]"
    write(u, fmt) "nrayr",  params%raytracing%nrayr
    write(u, fmt) "nrayth", params%raytracing%nrayth
    if (params%raytracing%rwmax /= defaults%raytracing%rwmax) &
      write(u, fmt) "rwmax", params%raytracing%rwmax
    if (params%raytracing%igrad /= defaults%raytracing%igrad) &
      write(u, fmt) "igrad", params%raytracing%igrad
    if (params%raytracing%ipass /= defaults%raytracing%ipass) &
      write(u, fmt) "ipass", params%raytracing%ipass
    if (params%raytracing%ipol .neqv. defaults%raytracing%ipol) &
      write(u, fmt) "ipol", format_bool(params%raytracing%ipol)
    write(u, fmt) "dst",   params%raytracing%dst
    if (params%raytracing%nstep /= defaults%raytracing%nstep) &
      write(u, fmt) "nstep", params%raytracing%nstep
    if (params%raytracing%idst /= defaults%raytracing%idst) &
      write(u, fmt) "idst",  format_step(params%raytracing%idst)

    write(u, '(/,a)') "[ecrh_cd]"
    if (params%ecrh_cd%iwarm /= defaults%ecrh_cd%iwarm) &
      write(u, fmt) "iwarm", format_absorp(params%ecrh_cd%iwarm)
    if (params%ecrh_cd%ieccd /= defaults%ecrh_cd%ieccd) &
      write(u, fmt) "ieccd", format_current(params%ecrh_cd%ieccd)
    if (params%ecrh_cd%ilarm /= defaults%ecrh_cd%ilarm) &
      write(u, fmt) "ilarm", params%ecrh_cd%ilarm
    if (params%ecrh_cd%imx /= defaults%ecrh_cd%imx) &
      write(u, fmt) "imx", params%ecrh_cd%imx

    write(u, '(/,a)') "[antenna]"
    write(u, fmt) "alpha", params%antenna%alpha
    write(u, fmt) "beta",  params%antenna%beta
    if (params%antenna%power /= defaults%antenna%power) &
      write(u, fmt) "power", params%antenna%power
    write(u, fmt) "iox",  format_polar(params%antenna%iox)
    write(u, fmt) "ibeam",  format_beam(params%antenna%ibeam)
    if (params%raytracing%ipol) then
      write(u, fmt) "psi",  params%antenna%psi
      write(u, fmt) "chi",  params%antenna%chi
    end if
    write(u, fmt) "filenm", quote(params%antenna%filenm)

    write(u, '(/,a)') "[equilibrium]"
    if (params%equilibrium%iequil /= defaults%equilibrium%iequil) &
      write(u, fmt) "iequil", format_equil(params%equilibrium%iequil)
    write(u, fmt) "filenm", quote(params%equilibrium%filenm)
    if (params%equilibrium%icocos /= defaults%equilibrium%icocos) &
      write(u, fmt) "icocos",  params%equilibrium%icocos
    if (params%equilibrium%ipsinorm .neqv. defaults%equilibrium%ipsinorm) &
      write(u, fmt) "ipsinorm", format_bool(params%equilibrium%ipsinorm)
    if (params%equilibrium%idesc .neqv. defaults%equilibrium%idesc) &
      write(u, fmt) "idesc", format_bool(params%equilibrium%idesc)
    if (params%equilibrium%ifreefmt .neqv. defaults%equilibrium%ifreefmt) &
      write(u, fmt) "ifreefmt", format_bool(params%equilibrium%ifreefmt)
    if (params%equilibrium%ixp /= defaults%equilibrium%ixp) &
      write(u, fmt) "ixp", format_x_point(params%equilibrium%ixp)
    if (params%equilibrium%ssplps /= defaults%equilibrium%ssplps) &
      write(u, fmt) "ssplps", params%equilibrium%ssplps
    if (params%equilibrium%ssplf /= defaults%equilibrium%ssplf) &
      write(u, fmt) "ssplf", params%equilibrium%ssplf
    if (params%equilibrium%sgnb /= defaults%equilibrium%sgnb) &
      write(u, fmt) "sgnb", params%equilibrium%sgnb
    if (params%equilibrium%sgni /= defaults%equilibrium%sgni) &
      write(u, fmt) "sgni", params%equilibrium%sgni
    if (params%equilibrium%factb /= defaults%equilibrium%factb) &
      write(u, fmt) "factb", params%equilibrium%factb

    write(u, '(/,a)') "[profiles]"
    write(u, fmt) "iprof", format_profiles(params%profiles%iprof)
    write(u, fmt) "irho", format_rho(params%profiles%irho)
    write(u, fmt) "filenm", quote(params%profiles%filenm)
    if (params%profiles%sspld /= defaults%profiles%sspld) &
      write(u, fmt) "sspld", params%profiles%sspld
    if (params%profiles%factne /= defaults%profiles%factne) &
      write(u, fmt) "factne", params%profiles%factne
    if (params%profiles%factte /= defaults%profiles%factte) &
      write(u, fmt) "factte", params%profiles%factte
    if (params%profiles%iscal /= defaults%profiles%iscal) &
      write(u, fmt) "iscal", format_scaling(params%profiles%iscal)
    if (params%profiles%psnbnd /= defaults%profiles%psnbnd) &
      write(u, fmt) "psnbnd", params%profiles%psnbnd

    write(u, '(/,a)') "[output]"
    if (params%output%ipec /= defaults%output%ipec) &
      write(u, fmt) "ipec", format_rho(params%output%ipec)
    if (params%output%nrho /= defaults%output%nrho) &
      write(u, fmt) "nrho", params%output%nrho
    if (params%output%istpr /= defaults%output%istpr) &
      write(u, fmt) "istpr", params%output%istpr
    if (params%output%istpl /= defaults%output%istpl) &
      write(u, fmt) "istpl", params%output%istpl

    write(u, '(/,a)') "[misc]"
    write(u, fmt) "rwall", params%misc%rwall

  end subroutine write_gray_config


  ! Helper functions for formatting values

  pure function format_bool(p) result(str)
    logical, intent(in) :: p
    character(len=:), allocatable :: str
    str = trim(merge("true ", "false", p))
  end function

  pure function format_step(val) result(str)
    integer(kind(step_enum)), intent(in) :: val
    character(len=:), allocatable :: str
    character(len=*), parameter :: choices(0:2) = &
      [character(len=11) :: "ARCLEN", "TIME", "PHASE"]
    str = "STEP_" // trim(choices(val))
  end function

  pure function format_absorp(val) result(str)
    integer(kind(absorption_enum)), intent(in) :: val
    character(len=:), allocatable :: str
    character(len=*), parameter :: choices(0:3) = &
      [character(len=8) :: "OFF", "WEAK", "FULL", "FULL_ALT"]
    str = "ABSORP_" // trim(choices(val))
  end function

  pure function format_current(val) result(str)
    integer(kind(current_drive_enum)), intent(in) :: val
    character(len=:), allocatable :: str
    character(len=*), parameter :: choices(0:3) = &
      [character(len=10) :: "OFF", "COHEN", "NO_TRAP", "NEOCLASSIC"]
    str = "CD_" // trim(choices(val))
  end function

  pure function format_polar(val) result(str)
    integer(kind(polar_enum)), intent(in) :: val
    character(len=:), allocatable :: str
    str = merge("MODE_O", "MODE_X", val == 1)
  end function

  pure function format_beam(val) result(str)
    integer(kind(beam_enum)), intent(in) :: val
    character(len=:), allocatable :: str
    character(len=*), parameter :: choices(0:2) = ["0D", "1D", "2D"]
    str = "BEAM_" // choices(val)
  end function

  pure function format_equil(val) result(str)
    integer(kind(equil_enum)), intent(in) :: val
    character(len=:), allocatable :: str
    character(len=*), parameter :: choices(0:3) = &
      [character(len=13) :: "VACUUM", "ANALYTICAL", &
       "EQDSK_FULL", "EQDSK_PARTIAL"]
    str = "EQ_" // trim(choices(val))
  end function

  pure function format_x_point(val) result(str)
    integer(kind(x_point_enum)), intent(in) :: val
    character(len=:), allocatable :: str
    character(len=*), parameter :: choices(-1:+1) = &
      [character(len=10) :: "AT_BOTTOM", "IS_MISSING", "AT_TOP"]
    str = "X_" // trim(choices(val))
  end function

  pure function format_scaling(val) result(str)
    integer(kind(scaling_enum)), intent(in) :: val
    character(len=:), allocatable :: str
    character(len=*), parameter :: choices(0:2) = &
      [character(len=9) :: "COLLISION", "GREENWALD", "OFF"]
    str = "SCALE_" // trim(choices(val))
  end function

  pure function format_rho(val) result(str)
    integer(kind(rho_enum)), intent(in) :: val
    character(len=:), allocatable :: str
    character(len=*), parameter :: choices(0:2) = ["TOR", "POL", "PSI"]
    str = "RHO_" // trim(choices(val))
  end function

  pure function format_profiles(val) result(str)
    integer(kind(profiles_enum)), intent(in) :: val
    character(len=:), allocatable :: str
    str = "PROF_" // trim(merge("ANALYTIC", "NUMERIC ", val == 0))
  end function

  pure function quote(str) result(quoted)
    character(*), intent(in) :: str
    character(len=:), allocatable :: quoted
    quoted = '"' // trim(str) // '"'
  end function

end program