module cubeadm_verify
  use cubetools_structure
  use cube_types
  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
    type(cube_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
    !
    character(len=*), parameter :: comm_help = strg_id
    type(cubeid_arg_t) :: cubearg
    character(len=*), parameter :: rname='VERIFY>REGISTER'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    ! Command
    call cubetools_register_command(&
         'VERIFY','[cube]',&
         'Verify if a FITS header is CUBE-conformant',&
         comm_help,&
         cubeadm_verify_command,&
         verify%comm,error)
    if (error) return
    call cubearg%register( &
         'CUBE', &
         '[CubeID]',  &
         strg_id,&
         code_arg_optional,  &
         [flag_any], &
         code_read_head,&  ! Header 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_header(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 cubetools_dataformat_types
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(verify_prog_t), intent(inout) :: prog
    logical,              intent(inout) :: error
    !
    type(gfits_hdict_t), pointer :: hdict
    integer(kind=4) :: naxis
    character(len=*), parameter :: rname='VERIFY>DO'
    !
    if (.not.prog%cube%tuple%haskind(code_dataformat_fits)) then
      call cubeadm_message(seve%w,rname,'Cube is not a FITS file')
      return
    endif
    !
    hdict => prog%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)
    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_do
  !
  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
  !
end module cubeadm_verify
