module cubelist_list
  use cubetools_parameters
  use cubelist_messaging
  use cubelist_object_class
  use cubelist_object_advanced_class
  use cubelist_list_types
  !---------------------------------------------------------------------
  ! Support module for generic list of list_t contents
  !---------------------------------------------------------------------
  !
  public :: list_column_t
  public :: cubelist_column_ptr
  public :: list_column_list_t
  private
  !
  integer(kind=4), parameter :: col_width_auto=0
  !
  ! Support for 1 column
  type, abstract, extends(list_object_t) :: list_column_t
    character(len=16), public  :: name    ! Column name (identifier)
    character(len=16), public  :: header  ! Column name in header (might be truncated)
    integer(kind=4),   private :: width = col_width_auto  ! Static or dynamic column width
  contains
    procedure(get_lrepr_interface), deferred :: get_lrepr  ! [private]
    procedure(get_repr_interface),  deferred :: get_repr   ! [private]
    procedure,                      private  :: width_auto => cubelist_column_width_auto
    procedure,                      public   :: copy       => cubelist_column_copy
  end type list_column_t
  !
  ! The collection of columns to be listed
  type, extends(list_t) :: list_column_list_t
    logical,                       public  :: doheader = .true.
    integer(kind=4),               public  :: olun = stdout
    logical,                       public  :: dopage = .false.
    character(len=:), allocatable, private :: one(:)  ! One column buffer (for 1 object)
    character(len=:), allocatable, private :: all(:)  ! All columns buffer (for 1 object)
  contains
    procedure, public  :: register  => cubelist_list_register_column
    procedure, public  :: get       => cubelist_list_get_column
    procedure, public  :: widths    => cubelist_list_widths
    generic,   public  :: line      => oneline,manylines
    procedure, private :: oneline   => cubelist_list_one_line
    procedure, private :: manylines => cubelist_list_many_lines
    procedure, public  :: act       => cubelist_list_act
  end type list_column_list_t
  !
contains
  !
  function cubelist_column_ptr(obj,error)
    !-------------------------------------------------------------------
    ! Check if the input class is of class(list_column_t), and return
    ! a pointer to it if relevant.
    !-------------------------------------------------------------------
    class(list_column_t), pointer :: cubelist_column_ptr
    class(list_object_t), pointer       :: obj
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='COLUMN>PTR'
    !
    select type(obj)
    class is (list_column_t)
      cubelist_column_ptr => obj
    class default
      cubelist_column_ptr => null()
      call cubelist_message(seve%e,rname,  &
        'Internal error: object is not a list_column_t type')
      error = .true.
      return
    end select
  end function cubelist_column_ptr
  !
  subroutine get_lrepr_interface(col,obj,lrepr,error)
    class(list_column_t),          intent(in)    :: col
    class(list_object_advanced_t), intent(in)    :: obj
    integer(kind=4),               intent(out)   :: lrepr
    logical,                       intent(inout) :: error
  end subroutine get_lrepr_interface
  !
  subroutine get_repr_interface(col,obj,lrepr,repr,nline,error)
    class(list_column_t),          intent(inout) :: col
    class(list_object_advanced_t), intent(inout) :: obj
    integer(kind=4),               intent(in)    :: lrepr
    character(len=*),              intent(out)   :: repr(:)
    integer(kind=4),               intent(out)   :: nline
    logical,                       intent(inout) :: error
  end subroutine get_repr_interface
  !
  subroutine cubelist_column_width_auto(col,list,error)
    !-------------------------------------------------------------------
    ! Compute the best width for one column supporting adaptative width,
    ! based on the index to be listed.
    !-------------------------------------------------------------------
    class(list_column_t), intent(inout) :: col   ! One column to be listed
    class(list_t),        intent(in)    :: list  ! The collection of objects (index) to be listed
    logical,              intent(inout) :: error
    !
    integer(kind=4) :: lrepr
    integer(kind=list_k) :: iobj
    class(list_object_advanced_t), pointer :: obj
    !
    col%width = 1
    do iobj=1,list%n
      obj => cubelist_object_advanced_ptr(list%list(iobj)%p,error)
      if (error)  return
      if (obj%hidden)  cycle
      call col%get_lrepr(obj,lrepr,error)
      if (error)  return
      col%width = max(col%width,lrepr)
    enddo
  end subroutine cubelist_column_width_auto
  !
  subroutine cubelist_column_copy(in,out,error)
    !-------------------------------------------------------------------
    ! Copy the known attributes of the abstract type. Nothing done on
    ! the unknown extended attributes,
    !-------------------------------------------------------------------
    class(list_column_t), intent(in)    :: in
    class(list_column_t), intent(inout) :: out
    logical,              intent(inout) :: error
    out%name = in%name
    out%header = in%header
  end subroutine cubelist_column_copy
  !
  !------------------------------------------------------------------------
  !
  subroutine cubelist_list_register_column(cols,col,name,header,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! Register a column in the global column list
    !----------------------------------------------------------------------
    class(list_column_list_t), intent(inout) :: cols
    class(list_column_t),      intent(inout) :: col
    character(len=*),          intent(in)    :: name
    character(len=*),          intent(in)    :: header
    logical,                   intent(inout) :: error
    !
    ! Attributes
    col%name = name
    col%header = header
    !
    ! Insert in global column list
    call cols%associate(col,error)
    if (error)  return
  end subroutine cubelist_list_register_column
  !
  subroutine cubelist_list_get_column(cols,name,col,error)
    !-------------------------------------------------------------------
    ! Return a pointer to the named column
    !-------------------------------------------------------------------
    class(list_column_list_t), intent(in)    :: cols
    character(len=*),          intent(in)    :: name
    class(list_column_t),      pointer       :: col
    logical,                   intent(inout) :: error
    !
    integer(kind=list_k) :: icol
    character(len=*), parameter :: rname='COLUMN>GET'
    !
    ! ZZZ Implement dichotomic search in sorted list!
    col => null()
    do icol=1,cols%n
      col => cubelist_column_ptr(cols%list(icol)%p,error)
      if (error)  return
      if (col%name.eq.name)  return
    enddo
    call cubelist_message(seve%e,rname,'Column not found: '//trim(name))
    error = .true.
  end subroutine cubelist_list_get_column
  !
  subroutine cubelist_list_act(cols,list,name,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(list_column_list_t), intent(inout) :: cols
    class(list_t),             intent(in)    :: list
    character(len=*),          intent(in)    :: name  ! Index name
    logical,                   intent(inout) :: error
    !
    integer(kind=list_k) :: ient
    integer(kind=4) :: tt_lines,iline
    character(len=mess_l) :: mess
    class(list_object_advanced_t), pointer :: obj
    character(len=*), parameter :: rname='LIST'
    !
    if (list%n.le.0) then
      call cubelist_message(seve%w,rname,'No entry in '//trim(name)//' index')
      return
    endif
    if (cols%n.le.0) then
      call cubelist_message(seve%e,rname,'Internal error: list of colums is empty')
      error = .true.
      return
    endif
    !
    ! Pre-compute columns widths (for those which are dynamic)
    call cols%widths(list,error)
    if (error)  return
    !
    tt_lines = sic_ttynlin()-1
    iline = 0
    !
    if (cols%doheader) then
      ! Print header
      call cubelist_list_header(cols,mess,error)
      if (error)  return
      call cubelist_list_print(mess,cols%olun,iline)
    endif
    !
    do ient=1,list%n
      ! Repeat header if relevant
      if (cols%doheader) then
        if (cols%olun.eq.stdout .and. cols%dopage) then
          if (mod(iline,tt_lines).eq.0) then
            if (hlp_more().ne.0)  return  ! Exit list by user request
            call cubelist_list_header(cols,mess,error)
            if (error)  return
            call cubelist_list_print(mess,cols%olun,iline)
          endif
        endif
      endif
      ! Show line for this object
      obj => cubelist_object_advanced_ptr(list%list(ient)%p,error)
      if (error)  return
      if (obj%hidden)  cycle
      call cubelist_list_object(cols,obj,iline,error)
      if (error)  return
    enddo
    !
    if (cols%doheader) then
      if (iline.gt.tt_lines .and. .not.cols%dopage) then
        ! Long list in non-page mode: repeat header at last line
        call cubelist_list_header(cols,mess,error)
        if (error)  return
        call cubelist_list_print(mess,cols%olun,iline)
      endif
    endif
  end subroutine cubelist_list_act
  !
  subroutine cubelist_list_widths(cols,list,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! Compute the best width for columns supporting adaptative width,
    ! based on the index to be listed.
    !-------------------------------------------------------------------
    class(list_column_list_t), intent(inout) :: cols  ! The collection of columns to be listed
    class(list_t),             intent(in)    :: list  ! The collection of objects (index) to be listed
    logical,                   intent(inout) :: error
    !
    integer(kind=4) :: maxwidth,totwidth,ier
    integer(kind=list_k) :: icol
    class(list_column_t), pointer :: col
    integer(kind=4), parameter :: mline=10
    character(len=*), parameter :: rname='LIST>WIDTHS'
    !
    maxwidth = 0
    totwidth = 0
    do icol=1,cols%n
      col => cubelist_column_ptr(cols%list(icol)%p,error)
      if (error)  return
      if (col%width.eq.col_width_auto) then
        call col%width_auto(list,error)
        if (error)  return
      endif
      maxwidth = max(maxwidth,col%width)
      totwidth = totwidth+col%width+1
    enddo
    !
    if (allocated(cols%one))  deallocate(cols%one)
    allocate(character(maxwidth)::cols%one(mline),stat=ier)
    if (failed_allocate(rname,'char buffer (1)',ier,error)) return
    if (allocated(cols%all))  deallocate(cols%all)
    allocate(character(totwidth)::cols%all(mline),stat=ier)
    if (failed_allocate(rname,'char buffer (2)',ier,error)) return
  end subroutine cubelist_list_widths
  !
  subroutine cubelist_list_header(cols,mess,error)
    !-------------------------------------------------------------------
    ! Build the header line
    !-------------------------------------------------------------------
    class(list_column_list_t), intent(inout) :: cols  ! The collection of columns to be listed
    character(len=*),          intent(out)   :: mess
    logical,                   intent(inout) :: error
    !
    integer(kind=4) :: nc
    integer(kind=list_k) :: icol
    class(list_column_t), pointer :: col
    !
    mess = ''
    nc = 0
    do icol=1,cols%n
      col => cubelist_column_ptr(cols%list(icol)%p,error)
      if (error)  return
      mess(nc+1:nc+col%width) = col%header
      nc = nc+1+col%width
    enddo
  end subroutine cubelist_list_header
  !
  subroutine cubelist_list_object(cols,obj,cntline,error)
    !-------------------------------------------------------------------
    ! Build and print the line for object 'obj' with the desired columns
    ! 'cols'.
    ! Note that some columns may spawn over several lines.
    !-------------------------------------------------------------------
    class(list_column_list_t),     intent(inout) :: cols  ! The collection of columns to be listed
    class(list_object_advanced_t), intent(inout) :: obj
    integer(kind=4),               intent(inout) :: cntline
    logical,                       intent(inout) :: error
    !
    integer(kind=4) :: mline,iline
    !
    cols%all(:) = ''
    call cols%line(obj,cols%all,mline,error)
    if (error)  return
    do iline=1,mline
      call cubelist_list_print(cols%all(iline),cols%olun,cntline)
    enddo
  end subroutine cubelist_list_object
  !
  subroutine cubelist_list_one_line(cols,obj,repr,error)
    !-------------------------------------------------------------------
    ! Build the line for object 'obj' with the desired columns 'cols'.
    ! Support only one line (see cubelist_list_many_lines)
    !-------------------------------------------------------------------
    class(list_column_list_t),     intent(inout) :: cols  ! The collection of columns to be listed
    class(list_object_advanced_t), intent(inout) :: obj
    character(len=*),              intent(inout) :: repr
    logical,                       intent(inout) :: error
    !
    integer(kind=4) :: nc,icol,nline
    class(list_column_t), pointer :: col
    character(len=*), parameter :: rname='LIST>ONE>LINE'
    !
    nc = 0
    do icol=1,cols%n
      col => cubelist_column_ptr(cols%list(icol)%p,error)
      if (error)  return
      cols%one(:) = ''
      call col%get_repr(obj,col%width,cols%one,nline,error)
      if (error)  return
      if (nline.gt.1) then
        call cubelist_message(seve%w,rname,  &
          'Column '//trim(col%name)//' requires more than one line')
      endif
      repr(nc+1:nc+col%width) = cols%one(1)
      nc = nc+1+col%width
    enddo
  end subroutine cubelist_list_one_line
  !
  subroutine cubelist_list_many_lines(cols,obj,repr,mline,error)
    !-------------------------------------------------------------------
    ! Build the line for object 'obj' with the desired columns 'cols'.
    ! Note that some columns may spawn over several lines.
    !-------------------------------------------------------------------
    class(list_column_list_t),     intent(inout) :: cols  ! The collection of columns to be listed
    class(list_object_advanced_t), intent(inout) :: obj
    character(len=*),              intent(inout) :: repr(:)
    integer(kind=4),               intent(out)   :: mline  ! Number of lines actually filled
    logical,                       intent(inout) :: error
    !
    integer(kind=4) :: nc,icol,nline,iline
    class(list_column_t), pointer :: col
    !
    nc = 0
    mline = 1
    do icol=1,cols%n
      col => cubelist_column_ptr(cols%list(icol)%p,error)
      if (error)  return
      cols%one(:) = ''
      call col%get_repr(obj,col%width,cols%one,nline,error)
      if (error)  return
      do iline=1,nline
        repr(iline)(nc+1:nc+col%width) = cols%one(iline)
      enddo
      nc = nc+1+col%width
      mline = max(nline,mline)
    enddo
  end subroutine cubelist_list_many_lines
  !
  subroutine cubelist_list_print(message,olun,iline)
    !---------------------------------------------------------------------
    !  Send the message to the given Logical Unit. Quite generic, could
    ! be used in other contexts.
    !---------------------------------------------------------------------
    character(len=*), intent(in)    :: message
    integer(kind=4),  intent(in)    :: olun
    integer(kind=4),  intent(inout) :: iline  ! Current line number
    !
    character(len=*), parameter :: rname='LIST'
    !
    iline = iline+1
    if (olun.eq.stdout) then
      call cubelist_message(seve%r,rname,message)
    else
      write(olun,'(A)') trim(message)
    endif
  end subroutine cubelist_list_print
  !
end module cubelist_list
