module cubeadm_verify
  use cubetools_structure
  use cubetuple_format_class
  use cubeadm_cubeid_types
  use cubeadm_messaging
  !
  public :: verify
  private
  !
  type :: verify_comm_t
    type(option_t),      pointer :: comm
    type(cubeid_arg_t),  pointer :: cube
  contains
    procedure, public  :: register => cubeadm_verify_register
    procedure, private :: parse    => cubeadm_verify_parse
    procedure, private :: main     => cubeadm_verify_main
  end type verify_comm_t
  type(verify_comm_t) :: verify
  !
  type verify_user_t
    type(cubeid_user_t)   :: cubeids
  contains
    procedure, private :: toprog => cubeadm_verify_user_toprog
  end type verify_user_t
  !
  type verify_prog_t
    class(format_t), pointer :: cube
  contains
    procedure, private :: do => cubeadm_verify_do
  end type verify_prog_t
  !
  interface cubeadm_verify_and_get
    module procedure cubeadm_verify_and_get_i4
  end interface cubeadm_verify_and_get
  !
  interface cubeadm_verify_and_compare
    module procedure cubeadm_verify_and_compare_ch
  end interface cubeadm_verify_and_compare
  !
contains
  !
  subroutine cubeadm_verify_command(line,error)
    !-------------------------------------------------------------------
    ! Support routine for command VERIFY
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(verify_user_t) :: user
    character(len=*), parameter :: rname='VERIFY>COMMAND'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call verify%parse(line,user,error)
    if (error) return
    call verify%main(user,error)
    if (error) return
  end subroutine cubeadm_verify_command
  !
  subroutine cubeadm_verify_register(verify,error)
    use cubedag_allflags
    !-------------------------------------------------------------------
    ! Register ADM\VERIFY command and its options
    !-------------------------------------------------------------------
    class(verify_comm_t), intent(in)    :: verify
    logical,              intent(inout) :: error
    !
    type(cubeid_arg_t) :: cubearg
    character(len=*), parameter :: rname='VERIFY>REGISTER'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    ! Command
    call cubetools_register_command(&
         'VERIFY','[cubeid]',&
         'Check whether a cube header is CUBE-conformant',&
         'Check whether the selected object satisfies current CUBE&
         & conformity checks. This commands is used in the DMS part&
         & of the Observatory Management System ( https://oms.iram.fr ).'//strg_bl//&
         'Behavior:'//strg_cr//&
         '- Verification path depends on detected object kind.'//strg_cr//&
         '- For cube-like objects, fatal prerequisites stop verification and'//strg_cr//&
         '  the command execution with an error. Other checks report missing'//strg_cr//&
         '  or non-conformant metadata.'//strg_cr//&
         '- For UV tables, detailed key-by-key conformity checks are&
         & currently not implemented.'//strg_bl//&
         'Notes:'//strg_cr//&
         '- An empty output means that the cube header is conformant.'//strg_bl//&
         'Examples:'//strg_cr//&
         '  CUBE> VERIFY'//strg_cr//&
         '  CUBE> VERIFY mycube'//strg_cr//&
         'Without argument, VERIFY checks the current object.',&
         cubeadm_verify_command,&
         verify%comm,error)
    if (error) return
    call cubearg%register(&
         'CUBE',&
         '[cubeid]',&
         strg_emp,&
         code_arg_optional,&
         [flag_any],&
         code_read_head,&  ! Data not needed
         code_access_any,&
         verify%cube,&
         error)
    if (error) return
  end subroutine cubeadm_verify_register
  !
  subroutine cubeadm_verify_parse(verify,line,user,error)
    !-------------------------------------------------------------------
    ! Parsing facility for command
    !   VERIFY CubeID
    !-------------------------------------------------------------------
    class(verify_comm_t), intent(in)    :: verify
    character(len=*),     intent(in)    :: line
    type(verify_user_t),  intent(out)   :: user
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='VERIFY>PARSE'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,verify%comm,user%cubeids,error)
    if (error) return
  end subroutine cubeadm_verify_parse
  !
  subroutine cubeadm_verify_main(verify,user,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(verify_comm_t), intent(in)    :: verify
    type(verify_user_t),  intent(in)    :: user
    logical,              intent(inout) :: error
    !
    type(verify_prog_t) :: prog
    character(len=*), parameter :: rname='verify>MAIN'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call user%toprog(verify,prog,error)
    if (error) return
    call prog%do(error)
    if (error) return
  end subroutine cubeadm_verify_main
  !
  !---------------------------------------------------------------------
  !
  subroutine cubeadm_verify_user_toprog(user,comm,prog,error)
    use cubeadm_get
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(verify_user_t), intent(in)    :: user
    type(verify_comm_t),  intent(in)    :: comm
    type(verify_prog_t),  intent(out)   :: prog
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='VERIFY>USER>TOPROG'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call cubeadm_get_fheader(verify%cube,user%cubeids,prog%cube,error)
    if (error) return
  end subroutine cubeadm_verify_user_toprog
  !
  subroutine cubeadm_verify_do(prog,error)
    use gkernel_types
    use cubeformats_uv
    use cube_types
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(verify_prog_t), intent(inout) :: prog
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='VERIFY>CHECK'
    !
    class(format_t), pointer :: format
    !
    format => prog%cube
    select type (format)
    type is (cube_t)
      call cubeadm_verify_check_cube(format,error)
      if (error) return
    type is (uv_t)
      call cubeadm_verify_check_uvt(format,error)
      if (error) return
    class default
      call cubeadm_message(seve%e,rname,'Unexpected file kind')
      error = .true.
      return
    end select
  end subroutine cubeadm_verify_do
  !
  subroutine cubeadm_verify_check_cube(cube,error)
    use gkernel_types
    use cubeio_dataformat_types
    use cube_types
    !-------------------------------------------------------------------
    ! Verify if a cube_t is CUBE conformant
    !-------------------------------------------------------------------
    type(cube_t), intent(in)    :: cube
    logical,      intent(inout) :: error
    !
    type(gfits_hdict_t), pointer :: hdict
    integer(kind=4) :: naxis
    character(len=*), parameter :: rname='VERIFY>CHECK>CUBE'
    !
    if (.not.cube%tuple%haskind(code_dataformat_fits)) then
      call cubeadm_message(seve%e,rname,'Cube is not a FITS file')
      error = .true.
      return
    endif
    !
    hdict => cube%tuple%current%file%hfits%dict
    !
    ! Convert information
    call cubeadm_verify_and_get(hdict,'NAXIS',naxis,error)
    if (error)  return
    if (naxis.ge.1) then
      call cubeadm_verify_one(hdict,'CTYPE1',error)
      call cubeadm_verify_one(hdict,'CRVAL1',error)
      call cubeadm_verify_one(hdict,'CDELT1',error)
      call cubeadm_verify_one(hdict,'CRPIX1',error)
    endif
    if (naxis.ge.2) then
      call cubeadm_verify_one(hdict,'CTYPE2',error)
      call cubeadm_verify_one(hdict,'CRVAL2',error)
      call cubeadm_verify_one(hdict,'CDELT2',error)
      call cubeadm_verify_one(hdict,'CRPIX2',error)
    endif
    if (naxis.ge.3) then
      call cubeadm_verify_one(hdict,'CTYPE3',error)
      call cubeadm_verify_one(hdict,'CRVAL3',error)
      call cubeadm_verify_one(hdict,'CDELT3',error)
      call cubeadm_verify_one(hdict,'CRPIX3',error)
    endif
    if (error)  return
    !
    ! Data information
    call cubeadm_verify_one(hdict,'DATAMIN', error)
    call cubeadm_verify_one(hdict,'DATAMAX', error)
    call cubeadm_verify_one(hdict,'BUNIT',   error)
   !call cubeadm_verify_one(hdict,'NOISETHE',error)  Might be absent if no value available
   !call cubeadm_verify_one(hdict,'NOISEMEA',error)  Might be absent if no value available
    if (error)  return
    !
    ! Spatial information
    call cubeadm_verify_one(hdict,'OBJECT', error)
    call cubeadm_verify_one(hdict,'RA',     error)
    call cubeadm_verify_one(hdict,'DEC',    error)
   !call cubeadm_verify_one(hdict,'RADESYS',error)  Not mandatory, because equinox could be arbitrary
    if (error)  return
    !
    ! Spectral information
    call cubeadm_verify_one(hdict,'LINE',    error)
    call cubeadm_verify_one(hdict,'RESTFREQ',error)
    call cubeadm_verify_one(hdict,'VELREF',  error)
   !call cubeadm_verify_one(hdict,'SPECSYS', error)  Redundant with VELREF but less information
   !call cubeadm_verify_one(hdict,'VELO-XXX',error)  Suffix depends on spectral frame (VELREF)
    call cubeadm_verify_one(hdict,'FREQRESO',error)  ! or WAVERESO depends on spectral kind
    if (error)  return
    !
    ! Resolution information
    call cubeadm_verify_one(hdict,'BMAJ',error)
    call cubeadm_verify_one(hdict,'BMIN',error)
    call cubeadm_verify_one(hdict,'BPA', error)
    if (error)  return
    !
    ! Misc
    call cubeadm_verify_one(hdict,'TELESCOP',error)
    if (error)  return
    !
    ! Origin
    call cubeadm_verify_and_compare(hdict,'ORIGIN','GILDAS CUBE',error)
    if (error)  return
  end subroutine cubeadm_verify_check_cube
  !
  subroutine cubeadm_verify_and_get_i4(hdict,key,value,error)
    use gkernel_types
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! Verify if a key is present and get its value (error if absent)
    !-------------------------------------------------------------------
    type(gfits_hdict_t), intent(in)    :: hdict
    character(len=*),    intent(in)    :: key
    integer(kind=4),     intent(out)   :: value
    logical,             intent(inout) :: error
    !
    logical :: found
    character(len=*), parameter :: rname='VERIFY>AND>GET'
    !
    call gfits_get_value(hdict,key,found,value,error)
    if (error)  return
    if (.not.found) then
      call cubeadm_message(seve%e,rname,'Missing key '''//trim(key)//''', can not verify more')
      error = .true.
      return
    endif
  end subroutine cubeadm_verify_and_get_i4
  !
  subroutine cubeadm_verify_and_compare_ch(hdict,key,expected,error)
    use gkernel_types
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! Verify if a key is present and if its value is as expected
    !-------------------------------------------------------------------
    type(gfits_hdict_t), intent(in)    :: hdict
    character(len=*),    intent(in)    :: key
    character(len=*),    intent(in)    :: expected
    logical,             intent(inout) :: error
    !
    logical :: found
    character(len=char0d_length) :: value
    character(len=*), parameter :: rname='VERIFY>AND>COMPARE'
    !
    call gfits_get_value(hdict,key,found,value,error)
    if (error)  return
    if (.not.found) then
      call cubeadm_message(seve%w,rname,'Missing key '''//trim(key)//'''')
      return
    endif
    if (value.ne.expected) then
      call cubeadm_message(seve%w,rname,'Key '''//trim(key)//''' is '''//  &
        trim(value)//''' (expected '''//trim(expected)//''')')
      return
    endif
  end subroutine cubeadm_verify_and_compare_ch
  !
  subroutine cubeadm_verify_one(hdict,key,error)
    use gkernel_types
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! Verify if a key is present
    !-------------------------------------------------------------------
    type(gfits_hdict_t), intent(in)    :: hdict
    character(len=*),    intent(in)    :: key
    logical,             intent(inout) :: error
    !
    logical :: found
    character(len=char0d_length) :: value
    character(len=*), parameter :: rname='VERIFY>ONE'
    !
    call gfits_get_value(hdict,key,found,value,error)
    if (error)  return
    if (.not.found)  &
      call cubeadm_message(seve%w,rname,'Missing key '''//trim(key)//'''')
  end subroutine cubeadm_verify_one
  !
  subroutine cubeadm_verify_check_uvt(uv,error)
    use cubeformats_uv
    !-------------------------------------------------------------------
    ! Verify if a uv_t is CUBE conformat
    !-------------------------------------------------------------------
    type(uv_t), intent(in)    :: uv
    logical,    intent(inout) :: error
    !
    character(len=*), parameter :: rname='VERIFY>CHECK>UV'
    !
    ! For now on we don't check anything as we only support GDF
    ! UV tables
  end subroutine cubeadm_verify_check_uvt
  !
end module cubeadm_verify
