!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubedag_list_column_types
  use cubelist_types
  use cubelist_list
  use cubedag_node_class
  use cubedag_history_buffer
  use cubedag_index_iterator_tool
  !---------------------------------------------------------------------
  ! This module offers support for the DAG-specific LIST, namely to
  ! describe the columns used in this context.
  !---------------------------------------------------------------------
  !
  public :: col_intrinsic_t
  public :: col_external_t
  public :: col_alias_t
  private
  !
  ! This type is able to 'list' an intrinsic value from a node, by calling
  ! its %get_repr() method.
  type, extends(list_column_t) :: col_intrinsic_t
  contains
    procedure         :: get_lrepr => col_intrinsic_lrepr  ! [private]
    procedure         :: get_repr  => col_intrinsic_repr   ! [private]
    procedure, public :: final     => col_intrinsic_final
  end type col_intrinsic_t
  !
  ! This type 'lists' a non-intrinsic property of a node, it requires some
  ! external information.
  type, extends(list_column_t) :: col_external_t
    integer(kind=list_k), private :: ient=0
  contains
    procedure         :: get_lrepr => col_external_lrepr  ! [private]
    procedure         :: get_repr  => col_external_repr   ! [private]
    procedure, public :: final     => col_external_final
  end type col_external_t
  !
  ! This type is not directly able to list values. It just provide an alias
  ! to other group of columns
  type, extends(list_column_t) :: col_alias_t
    integer(kind=4)                :: n
    character(len=16), allocatable :: aliased(:)
  contains
    procedure, public :: declare   => col_alias_declare
    procedure         :: get_lrepr => col_alias_lrepr  ! [private]
    procedure         :: get_repr  => col_alias_repr   ! [private]
    procedure, public :: final     => col_alias_final
  end type col_alias_t
  !
contains
  !
  !---------------------------------------------------------------------
  subroutine col_intrinsic_lrepr(col,obj,lrepr,error)
    class(col_intrinsic_t),        intent(in)    :: col
    class(list_object_advanced_t), intent(in)    :: obj
    integer(kind=4),               intent(out)   :: lrepr
    logical,                       intent(inout) :: error
    call obj%get_lrepr(col%name,lrepr,error)
    if (error)  return
  end subroutine col_intrinsic_lrepr
  subroutine col_intrinsic_repr(col,obj,lrepr,repr,nline,error)
    class(col_intrinsic_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
    call obj%get_repr(col%name,lrepr,repr,nline,error)
    if (error)  return
  end subroutine col_intrinsic_repr
  subroutine col_intrinsic_final(obj,error)
    class(col_intrinsic_t), intent(inout) :: obj
    logical,                intent(inout) :: error
  end subroutine col_intrinsic_final
  !---------------------------------------------------------------------
  subroutine col_external_lrepr(col,obj,lrepr,error)
    class(col_external_t),         intent(in)    :: col
    class(list_object_advanced_t), intent(in)    :: obj
    integer(kind=4),               intent(out)   :: lrepr
    logical,                       intent(inout) :: error
    class(cubedag_node_object_t), pointer :: node
    character(len=24) :: str24
    select case (col%name)
    case ('ENTRY')
      lrepr = 5
    case ('HISTORY')
      node => cubedag_node_ptr(obj,error)
      if (error)  return
      call cubedag_history_tostr(node%node%history,str24,error)
      lrepr = len_trim(str24)
    case ('LEADING','TRAILING')
      lrepr = 3
    case ('SEPARATOR')
      lrepr = 1
    case default
      lrepr = 3
    end select
  end subroutine col_external_lrepr
  subroutine col_external_repr(col,obj,lrepr,repr,nline,error)
    class(col_external_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
    class(cubedag_node_object_t), pointer :: node
    type(index_iterator_t) :: iter
    nline = 1
    col%ient = col%ient+1
    node => cubedag_node_ptr(obj,error)
    if (error)  return
    select case (col%name)
    case ('ENTRY')
      write(repr(1),'(I5)')   col%ient
    case ('HISTORY')
      call cubedag_history_tostr(node%node%history,repr(1),error)
      if (error)  return
    case ('LEADING')
      if (iter%is_current(node%node%id))  repr(1) = '>>>'
    case ('TRAILING')
      if (iter%is_current(node%node%id))  repr(1) = '<<<'
    case ('SEPARATOR')
      repr(1) = '|'
    case default
      repr(1) = 'N/A'
    end select
  end subroutine col_external_repr
  subroutine col_external_final(obj,error)
    class(col_external_t), intent(inout) :: obj
    logical,               intent(inout) :: error
  end subroutine col_external_final
  !---------------------------------------------------------------------
  subroutine col_alias_declare(col,aliased,error)
    class(col_alias_t), intent(inout) :: col
    character(len=*),   intent(in)    :: aliased(:)
    logical,            intent(inout) :: error
    col%n = size(aliased)
    allocate(col%aliased(col%n))
    col%aliased(:) = aliased(:)
  end subroutine col_alias_declare
  subroutine col_alias_lrepr(col,obj,lrepr,error)
    class(col_alias_t),            intent(in)    :: col
    class(list_object_advanced_t), intent(in)    :: obj
    integer(kind=4),               intent(out)   :: lrepr
    logical,                       intent(inout) :: error
    ! Irrelevant
  end subroutine col_alias_lrepr
  subroutine col_alias_repr(col,obj,lrepr,repr,nline,error)
    class(col_alias_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
    ! Irrelevant
  end subroutine col_alias_repr
  subroutine col_alias_final(obj,error)
    class(col_alias_t), intent(inout) :: obj
    logical,            intent(inout) :: error
    if (allocated(obj%aliased))  deallocate(obj%aliased)
  end subroutine col_alias_final
  !
end module cubedag_list_column_types
!
module cubedag_list_columns
  use cubelist_types
  use cubelist_list
  use cubedag_messaging
  use cubedag_list_column_types
  !---------------------------------------------------------------------
  ! This modules registers all the possible columns used for the
  ! DAG-related LIST
  !---------------------------------------------------------------------
  !
  public :: cubedag_list_columns_init
  public :: cubedag_list_columns_parse
  public :: cubedag_list_columns_fetch
  public :: list_column_names
  private
  !
  ! Intrinsic-kind columns
  type(col_intrinsic_t) :: col_id
  type(col_intrinsic_t) :: col_parents
  type(col_intrinsic_t) :: col_children
  type(col_intrinsic_t) :: col_twins
  type(col_intrinsic_t) :: col_unit
  type(col_intrinsic_t) :: col_source
  type(col_intrinsic_t) :: col_ptype
  type(col_intrinsic_t) :: col_l0
  type(col_intrinsic_t) :: col_m0
  type(col_intrinsic_t) :: col_pang
  type(col_intrinsic_t) :: col_lres
  type(col_intrinsic_t) :: col_mres
  type(col_intrinsic_t) :: col_line
  type(col_intrinsic_t) :: col_restf
  type(col_intrinsic_t) :: col_fres
  type(col_intrinsic_t) :: col_vsys
  type(col_intrinsic_t) :: col_rmaj
  type(col_intrinsic_t) :: col_rmin
  type(col_intrinsic_t) :: col_rang
  type(col_intrinsic_t) :: col_observatory
  type(col_intrinsic_t) :: col_location
  type(col_intrinsic_t) :: col_order
  type(col_intrinsic_t) :: col_access
  type(col_intrinsic_t) :: col_origin
  type(col_intrinsic_t) :: col_family
  type(col_intrinsic_t) :: col_flag
  type(col_intrinsic_t) :: col_cubeid
  type(col_intrinsic_t) :: col_type
  type(col_intrinsic_t) :: col_uservar
  type(col_intrinsic_t) :: col_memsize
  type(col_intrinsic_t) :: col_disksize
  type(col_intrinsic_t) :: col_datasize
  type(col_intrinsic_t) :: col_datatype
  !
  ! External columns
  type(col_external_t) :: col_entry
  type(col_external_t) :: col_history
  type(col_external_t) :: col_leading
  type(col_external_t) :: col_trailing
  type(col_external_t) :: col_separ
  !
  ! Alias names
  type(col_alias_t) :: col_default
  type(col_alias_t) :: col_beam
  type(col_alias_t) :: col_proj
  type(col_alias_t) :: col_graph
  type(col_alias_t) :: col_spec
  type(col_alias_t) :: col_spat
  type(col_alias_t) :: col_tuple
  type(col_alias_t) :: col_size
  type(col_alias_t) :: col_current
  !
  ! The global list of columns for LIST
  type(list_column_list_t) :: list_columns
  !
  ! The global list of column names for LIST
  character(len=16), allocatable :: list_column_names(:)
  !
contains
  !
  subroutine cubedag_list_columns_init(error)
    !-------------------------------------------------------------------
    ! Register all columns in the 'list_columns' global list
    !-------------------------------------------------------------------
    logical, intent(inout) :: error
    !
    ! ORDER MATTERS HERE: column names will appear like this in LIST /COL ?
    !
    ! Intrinsic kind columns
    call list_columns%register(col_id,         'IDENTIFIER', 'Id',         error)
    call list_columns%register(col_parents,    'PARENTS',    'Parents',    error)
    call list_columns%register(col_children,   'CHILDREN',   'Children',   error)
    call list_columns%register(col_twins,      'TWINS',      'Twins',      error)
    call list_columns%register(col_unit,       'UNIT',       'Unit',       error)
    call list_columns%register(col_source,     'SOURCE',     'Source',     error)
    call list_columns%register(col_ptype,      'PROJTYPE',   'ProjType',   error)
    call list_columns%register(col_l0,         'L0',         'L0',         error)
    call list_columns%register(col_m0,         'M0',         'M0',         error)
    call list_columns%register(col_pang,       'PROJANGLE',  'ProjAngle',  error)
    call list_columns%register(col_lres,       'SPALINC',    'SpaLInc',    error)
    call list_columns%register(col_mres,       'SPAMINC',    'SpaMInc',    error)
    call list_columns%register(col_line,       'LINE',       'Line',       error)
    call list_columns%register(col_restf,      'SPEFREQVAL', 'SpeFreqVal', error)
    call list_columns%register(col_fres,       'SPEFREQINC', 'FreqIncr',   error)
    call list_columns%register(col_vsys,       'SPEVELOVAL', 'VeloValue',  error)
    call list_columns%register(col_rmaj,       'BMAJOR',     'BeaMajor',   error)
    call list_columns%register(col_rmin,       'BMINOR',     'BeaMinor',   error)
    call list_columns%register(col_rang,       'BPA',        'BeaPA',      error)
    call list_columns%register(col_observatory,'OBSERVATORY','Observatory',error)
    call list_columns%register(col_location,   'LOCATION',   'Location',   error)
    call list_columns%register(col_order,      'ORDER',      'Order',      error)
    call list_columns%register(col_access,     'ACCESS',     'Access',     error)
    call list_columns%register(col_origin,     'ORIGIN',     'Origin',     error)
    call list_columns%register(col_family,     'FAMILY',     'Family',     error)
    call list_columns%register(col_flag,       'FLAGS',      'Flags',      error)
    call list_columns%register(col_cubeid,     'CUBEID',     'CubeID',     error)
    call list_columns%register(col_type,       'TYPE',       'Type',       error)
    call list_columns%register(col_uservar,    'VARIABLE',   'Variable',   error)
    call list_columns%register(col_memsize,    'MEMSIZE',    'MemoSize',   error)
    call list_columns%register(col_disksize,   'DISKSIZE',   'DiskSize',   error)
    call list_columns%register(col_datasize,   'DATASIZE',   'DataSize',   error)
    call list_columns%register(col_datatype,   'DATATYPE',   'DataType',   error)
    if (error)  return
    !
    ! External-kind columns
    call list_columns%register(col_entry,   'ENTRY',    'Entry',  error)
    call list_columns%register(col_history, 'HISTORY',  'History',error)
    call list_columns%register(col_leading, 'LEADING',  '',       error)
    call list_columns%register(col_trailing,'TRAILING', '',       error)
    call list_columns%register(col_separ,   'SEPARATOR','|',      error)
    if (error)  return
    !
    ! Alias columns (headers are irrelevant)
    call list_columns%register(col_default,'DEFAULT',   '',error)
    call list_columns%register(col_beam,   'BEAM',      '',error)
    call list_columns%register(col_proj,   'PROJECTION','',error)
    call list_columns%register(col_graph,  'GRAPH',     '',error)
    call list_columns%register(col_spec,   'SPECTRAL',  '',error)
    call list_columns%register(col_spat,   'SPATIAL',   '',error)
    call list_columns%register(col_tuple,  'TUPLE',     '',error)
    call list_columns%register(col_size,   'SIZE',      '',error)
    call list_columns%register(col_current,'CURRENT',   '',error)
    if (error)  return
    !
    ! Alias translations
    call col_default%declare(['LEADING    ','IDENTIFIER ','TYPE       ',  &
                              'CUBEID     ','OBSERVATORY','SOURCE     ',  &
                              'LINE       ','HISTORY    ','TRAILING   '],error)
    call col_beam%declare   (['BMAJOR     ','BMINOR     ','BPA        '],error)
    call col_proj%declare   (['PROJTYPE   ','L0         ','M0         ',  &
                              'PROJANGLE  '],error)
    call col_graph%declare  (['FAMILY     ','PARENTS    ','CHILDREN   ',  &
                              'TWINS      '],error)
    call col_spec%declare   (['LINE       ','SPEFREQVAL ','SPEFREQINC ',  &
                              'SPEVELOVAL '],error)
    call col_spat%declare   (['SOURCE     ','L0         ','M0         ',  &
                              'SPALINC    ','SPAMINC    '],error)
    call col_tuple%declare  (['ACCESS     ','LOCATION   '],error)
    call col_size%declare   (['DATASIZE   ','MEMSIZE    ','DISKSIZE   '],error)
    call col_current%declare(['LEADING    ','TRAILING   '],error)
    !
    ! Gather all names in a simple list
    call cubedag_list_columns_names(list_column_names,error)
    if (error)  return
  end subroutine cubedag_list_columns_init
  !
  subroutine cubedag_list_columns_names(names,error)
    !-------------------------------------------------------------------
    ! Gather the names of standard columns and aliases in a list
    !-------------------------------------------------------------------
    character(len=*), allocatable, intent(out)   :: names(:)
    logical,                       intent(inout) :: error
    !
    class(list_column_t), pointer :: col
    integer(kind=4) :: icol
    !
    allocate(names(list_columns%n))
    do icol=1,list_columns%n
      col => cubelist_column_ptr(list_columns%list(icol)%p,error)
      if (error)  return
      names(icol) = col%name
    enddo
  end subroutine cubedag_list_columns_names
  !
  subroutine cubedag_list_columns_parse(ncol,ucols,pcols,error)
    !---------------------------------------------------------------------
    ! Convert a list of user inputs (disambiguate) to the proper list of
    ! columns
    !---------------------------------------------------------------------
    integer(kind=4),  intent(in)    :: ncol      !
    character(len=*), intent(in)    :: ucols(:)  ! User inputs
    character(len=*), intent(out)   :: pcols(:)  ! Prog columns
    logical,          intent(inout) :: error     !
    !
    integer(kind=4) :: ukeys(ncol)
    !
    call cubedag_list_columns_disambiguate(ncol,ucols,ukeys,error)
    if (error)  return
    call cubedag_list_columns_set(ukeys,pcols,error)
    if (error)  return
  end subroutine cubedag_list_columns_parse
  !
  subroutine cubedag_list_columns_disambiguate(ncol,ucols,ukeys,error)
    use cubetools_disambiguate
    !---------------------------------------------------------------------
    ! Disambiguate list of user inputs into column indices
    !---------------------------------------------------------------------
    integer(kind=4),  intent(in)    :: ncol      !
    character(len=*), intent(in)    :: ucols(:)  ! User inputs
    integer(kind=4),  intent(out)   :: ukeys(:)  ! User key indices
    logical,          intent(inout) :: error     !
    !
    integer(kind=4) :: iarg
    character(len=12) :: key
    !
    ukeys(:) = 0
    do iarg=1,ncol
      call cubetools_disambiguate_strict(ucols(iarg),list_column_names,  &
        ukeys(iarg),key,error)
      if (error)  return
    enddo
  end subroutine cubedag_list_columns_disambiguate
  !
  subroutine cubedag_list_columns_set(ukeys,ckeys,error)
    !---------------------------------------------------------------------
    ! Translate the list of columns to actual columns (i.e. including
    ! translation of aliases)
    !---------------------------------------------------------------------
    integer(kind=4),  intent(in)    :: ukeys(:)  !
    character(len=*), intent(out)   :: ckeys(:)  !
    logical,          intent(inout) :: error     !
    ! Local
    character(len=*), parameter :: rname='LIST'
    integer(kind=4) :: ikey,iout,nnew,itmp
    character(len=16) :: new(10)
    character(len=16) :: ctmp(size(ckeys))
    !
    ctmp(:) = ''
    iout=0
    do ikey=1,size(ukeys)
      if (ukeys(ikey).le.0)  exit
      !
      select type (col => list_columns%list(ukeys(ikey))%p)
      type is (col_intrinsic_t)
        nnew = 1
        new(1) = col%name
      type is (col_external_t)
        nnew = 1
        new(1) = col%name
      type is (col_alias_t)
        nnew = col%n
        new(1:nnew) = col%aliased(:)
      class default
        call cubedag_message(seve%e,rname,'Unexpected column kind')
        error = .true.
        return
      end select
      !
      if (iout+nnew.gt.size(ctmp)) then
        call cubedag_message(seve%w,rname,'/COLUMNS list too long, truncated')
        return
      endif
      ctmp(iout+1:iout+nnew) = new(1:nnew)
      iout = iout+nnew
    enddo
    !
    ! Special: move current marker columns at first and last positions
    ckeys(:) = ''
    ikey = 0
    if (any(ctmp(1:iout).eq.'LEADING')) then
      ikey = ikey+1
      ckeys(ikey) = 'LEADING'
    endif
    do itmp=1,iout
      if (ctmp(itmp).eq.'LEADING')   cycle
      if (ctmp(itmp).eq.'TRAILING')  cycle
      ikey = ikey+1
      ckeys(ikey) = ctmp(itmp)
    enddo
    if (any(ctmp(1:iout).eq.'TRAILING')) then
      ikey = ikey+1
      ckeys(ikey) = 'TRAILING'
    endif
  end subroutine cubedag_list_columns_set
  !
  subroutine cubedag_list_columns_fetch(name,cols,error)
    !-------------------------------------------------------------------
    ! Return a pointer to the named column
    !-------------------------------------------------------------------
    character(len=*),         intent(in)    :: name
    type(list_column_list_t), intent(inout) :: cols
    logical,                  intent(inout) :: error
    !
    class(list_column_t), pointer :: model,col
    class(list_object_t), pointer :: lot
    !
    ! Fetch the column based on its name
    call list_columns%get(name,model,error)
    if (error)  return
    !
    ! Allocate a COPY because the 'list_column_t' are internally
    ! modified at each call. Copies allow for possible concurrent calls.
    call cols%allocate(model,lot,error)
    if (error)  return
    col => cubelist_column_ptr(lot,error)
    if (error)  return
    call model%copy(col,error)
    if (error)  return
  end subroutine cubedag_list_columns_fetch
end module cubedag_list_columns
!
module cubedag_list_types
  use cubelist_list
  use cubetools_parameters
  use cubedag_messaging
  use cubedag_link_type
  use cubedag_list_columns
  !
  public :: cubedag_list_link
  public :: cubedag_list_user_t
  public :: cubedag_list_prog_t
  private
  !
  type cubedag_list_user_t
    character(len=argu_l) :: ucols(20)
    integer(kind=4)       :: ncol
    logical               :: dopage
  contains
    procedure, public :: toprog => cubedag_list_user_toprog
  end type cubedag_list_user_t
  !
  type cubedag_list_prog_t
    type(list_column_list_t), private :: cols
  contains
    procedure, public :: do => cubedag_list_do
  end type cubedag_list_prog_t
  !
contains
  !
  subroutine cubedag_list_user_toprog(user,prog,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(cubedag_list_user_t), intent(in)    :: user
    type(cubedag_list_prog_t),  intent(out)   :: prog
    logical,                    intent(inout) :: error
    !
    character(len=16) :: custom(20)  ! Up to 20 custom columns
    !
    call cubedag_list_columns_parse(user%ncol,user%ucols,custom,error)
    if (error)  return
    call cubedag_list_register_columns(prog%cols,custom,.true.,stdout,user%dopage,error)
    if (error) then
      call prog%cols%final(error)
      return
    endif
  end subroutine cubedag_list_user_toprog
  !
  subroutine cubedag_list_do(prog,optx,optname,olun,error)
    !-------------------------------------------------------------------
    ! Execution routine for command LIST
    !-------------------------------------------------------------------
    class(cubedag_list_prog_t), intent(inout) :: prog
    type(cubedag_link_t),       intent(in)    :: optx
    character(len=*),           intent(in)    :: optname
    integer(kind=4),            intent(in)    :: olun
    logical,                    intent(inout) :: error
    !
    prog%cols%olun = olun
    call prog%cols%act(optx,optname,error)
    if (error)  continue
    call prog%cols%final(error)
    if (error)  return
  end subroutine cubedag_list_do
  !
  subroutine cubedag_list_link(link,lkname,ucols,doheader,olun,dopage,error)
    !-------------------------------------------------------------------
    ! List objects from a cubedag_link_t
    !-------------------------------------------------------------------
    type(cubedag_link_t), intent(in)    :: link
    character(len=*),     intent(in)    :: lkname
    character(len=*),     intent(in)    :: ucols(:)
    logical,              intent(in)    :: doheader
    integer(kind=4),      intent(in)    :: olun
    logical,              intent(in)    :: dopage
    logical,              intent(inout) :: error
    !
    character(len=16) :: custom(20)  ! Up to 20 custom columns
    type(list_column_list_t) :: cols
    !
    ! Set up columns
    call cubedag_list_columns_parse(size(ucols),ucols,custom,error)
    if (error)  return
    call cubedag_list_register_columns(cols,custom,doheader,olun,dopage,error)
    if (error)  goto 10
    call cols%act(link,lkname,error)
    if (error)  goto 10
  10 continue
    call cols%final(error)
    if (error)  return
  end subroutine cubedag_list_link
  !
  subroutine cubedag_list_register_columns(cols,custom,doheader,olun,dopage,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(list_column_list_t), intent(inout) :: cols
    character(len=*),         intent(in)    :: custom(:)  ! Custom list of columns
    logical,                  intent(in)    :: doheader
    integer(kind=4),          intent(in)    :: olun
    logical,                  intent(in)    :: dopage
    logical,                  intent(inout) :: error
    !
    integer(kind=4) :: icol
    !
    do icol=1,size(custom)
      if (custom(icol).eq.' ')  exit
      call cubedag_list_columns_fetch(custom(icol),cols,error)
      if (error)  return
    enddo
    !
    cols%doheader = doheader
    cols%olun     = olun
    cols%dopage   = dopage
  end subroutine cubedag_list_register_columns
end module cubedag_list_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
