module cubelist_object_advanced_class
  use cubelist_messaging
  use cubelist_object_class
  !---------------------------------------------------------------------
  ! An "advanced object" is the same as the basic 'list_object_t' except
  ! it has properties which can be listed (e.g. LIST), filtered (e.g.
  ! FIND), instantiated (e.g. VARIABLE).
  !
  ! The counterpart is that such object must provide get_value_*
  ! methods.
  !---------------------------------------------------------------------
  !
  public :: list_object_advanced_t
  public :: cubelist_object_advanced_ptr
  private
  !
  type, abstract, extends(list_object_t) :: list_object_advanced_t
    logical, public :: hidden = .false.  ! Hidden to LIST, FIND, etc
  contains
    procedure, public :: hide => cubelist_object_advanced_hide
    generic,   public :: get_value => get_value_i4,get_value_i8,  &
                                      get_value_r4,get_value_r8,  &
                                      get_value_cc
    procedure(get_value_i4_interface), deferred         :: get_value_i4  ! [private]
    procedure(get_value_i8_interface), deferred         :: get_value_i8  ! [private]
    procedure(get_value_r4_interface), deferred         :: get_value_r4  ! [private]
    procedure(get_value_r8_interface), deferred         :: get_value_r8  ! [private]
    procedure(get_value_cc_interface), deferred         :: get_value_cc  ! [private]
    procedure(get_lrepr_interface),    deferred, public :: get_lrepr
    procedure(get_repr_interface),     deferred, public :: get_repr
  end type list_object_advanced_t
  !
  abstract interface
    subroutine get_value_i4_interface(obj,name,found,value,error)
      import list_object_advanced_t
      !-------------------------------------------------------------------
      ! Get an I*4 property from an object.
      ! - Found is set to .false. if the named property does not exist for
      !   this object. This is not an error: you do not want LIST or FIND
      !   to fail on an heterogeneous index. Input 'value' is preserved.
      ! - Found is set to .true. if the named property exists and is
      !   indeed an I*4; value returned in 'value'.
      ! - Error is set to .true. if the named property exists but is not
      !   I*4. This is considered as a programming error (programmer
      !   mistake: he used the wrong combination of "name" and 'value'
      !   kind).
      !-------------------------------------------------------------------
      class(list_object_advanced_t), intent(in)    :: obj
      character(len=*),              intent(in)    :: name  ! Property name
      logical,                       intent(out)   :: found
      integer(kind=4),               intent(inout) :: value
      logical,                       intent(inout) :: error
    end subroutine get_value_i4_interface
    subroutine get_value_i8_interface(obj,name,found,value,error)
      import list_object_advanced_t
      class(list_object_advanced_t), intent(in)    :: obj
      character(len=*),              intent(in)    :: name  ! Property name
      logical,                       intent(out)   :: found
      integer(kind=8),               intent(inout) :: value
      logical,                       intent(inout) :: error
    end subroutine get_value_i8_interface
    subroutine get_value_r4_interface(obj,name,found,value,error)
      import list_object_advanced_t
      class(list_object_advanced_t), intent(in)    :: obj
      character(len=*),              intent(in)    :: name  ! Property name
      logical,                       intent(out)   :: found
      real(kind=4),                  intent(inout) :: value
      logical,                       intent(inout) :: error
    end subroutine get_value_r4_interface
    subroutine get_value_r8_interface(obj,name,found,value,error)
      import list_object_advanced_t
      class(list_object_advanced_t), intent(in)    :: obj
      character(len=*),              intent(in)    :: name  ! Property name
      logical,                       intent(out)   :: found
      real(kind=8),                  intent(inout) :: value
      logical,                       intent(inout) :: error
    end subroutine get_value_r8_interface
    subroutine get_value_cc_interface(obj,name,found,value,error)
      import list_object_advanced_t
      class(list_object_advanced_t), intent(in)    :: obj
      character(len=*),              intent(in)    :: name  ! Property name
      logical,                       intent(out)   :: found
      character(len=*),              intent(inout) :: value
      logical,                       intent(inout) :: error
    end subroutine get_value_cc_interface
    !
    subroutine get_lrepr_interface(obj,name,width,error)
      import list_object_advanced_t
      class(list_object_advanced_t), intent(in)    :: obj
      character(len=*),              intent(in)    :: name  ! Property name
      integer(kind=4),               intent(out)   :: width ! Computed column width
      logical,                       intent(inout) :: error
    end subroutine get_lrepr_interface
    subroutine get_repr_interface(obj,name,width,repr,nline,error)
      import list_object_advanced_t
      class(list_object_advanced_t), intent(inout) :: obj
      character(len=*),              intent(in)    :: name  ! Property name
      integer(kind=4),               intent(in)    :: width ! Expected column width
      character(len=*),              intent(out)   :: repr(:)
      integer(kind=4),               intent(out)   :: nline
      logical,                       intent(inout) :: error
    end subroutine get_repr_interface
  end interface
  !
contains
  !
  function cubelist_object_advanced_ptr(obj,error)
    !-------------------------------------------------------------------
    ! Check if the input class is of class(list_object_advanced_t), and return
    ! a pointer to it if relevant.
    !-------------------------------------------------------------------
    class(list_object_advanced_t), pointer :: cubelist_object_advanced_ptr
    class(list_object_t), pointer       :: obj
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBJECT>ADVANCED>PTR'
    !
    select type(obj)
    class is (list_object_advanced_t)
      cubelist_object_advanced_ptr => obj
    class default
      cubelist_object_advanced_ptr => null()
      call cubelist_message(seve%e,rname,  &
        'Internal error: object is not a list_object_advanced_t type')
      error = .true.
      return
    end select
  end function cubelist_object_advanced_ptr
  !
  subroutine cubelist_object_advanced_hide(obj)
    class(list_object_advanced_t), intent(inout) :: obj
    obj%hidden = .true.
  end subroutine cubelist_object_advanced_hide
end module cubelist_object_advanced_class
