module cubedag_history_buffer
  use cubedag_parameters
  use cubedag_messaging
  use cubedag_node_class
  use cubedag_link_type
  use cubedag_history_types
  !---------------------------------------------------------------------
  ! Support module for the history buffer, and subroutines to interact
  ! with it
  !---------------------------------------------------------------------

  type(cubedag_history_list_t) :: hx  ! History index

  public :: hx

  public :: cubedag_history_get_object
  public :: cubedag_history_add_tohx
  public :: cubedag_history_list_hx
  public :: cubedag_history_entrynum_hx
  public :: cubedag_history_tostr
  public :: cubedag_history_removenode,cubedag_history_removecommand
  public :: cubedag_history_destroy
  private

contains

  subroutine cubedag_history_get_object(hid,hobj,error)
    !-------------------------------------------------------------------
    ! Given the history identifier, find the associated object in HX
    ! and return a pointer to it
    !-------------------------------------------------------------------
    integer(kind=iden_l),    intent(in)    :: hid
    type(cubedag_history_t), pointer       :: hobj
    logical,                 intent(inout) :: error
    !
    integer(kind=entr_k) :: ihist
    !
    ihist = hx%entrynum(hid,error)
    if (error)  return
    hobj => cubedag_history_ptr(hx%list(ihist)%p,error)
    if (error)  return
  end subroutine cubedag_history_get_object

  subroutine cubedag_history_add_tohx(command,line,inputs,outputs,hid,error)
    !-------------------------------------------------------------------
    ! Add a new command in the HISTORY index. Return the associated
    ! history identifier.
    !-------------------------------------------------------------------
    character(len=*),     intent(in)    :: command
    character(len=*),     intent(in)    :: line
    type(cubedag_link_t), intent(in)    :: inputs
    type(cubedag_link_t), intent(in)    :: outputs
    integer(kind=entr_k), intent(out)   :: hid
    logical,              intent(inout) :: error
    !
    if (outputs%n.le.0) then
      ! The commands which do not create an output cube are not
      ! registered in history
      hid = 0
      return
    endif
    !
    call hx%add(command,line,inputs,outputs,hid,error)
    if (error)  return
  end subroutine cubedag_history_add_tohx

  subroutine cubedag_history_list_hx(error)
    !-------------------------------------------------------------------
    ! List the history index
    !-------------------------------------------------------------------
    logical, intent(inout) :: error
    !
    call hx%liste(error)
    if (error)  return
  end subroutine cubedag_history_list_hx

  function cubedag_history_entrynum_hx(hid,error)
    !-------------------------------------------------------------------
    ! Return the entry number in in HX corresponding to entry ID
    !-------------------------------------------------------------------
    integer(kind=entr_k) :: cubedag_history_entrynum_hx
    integer(kind=iden_l), intent(in)    :: hid
    logical,              intent(inout) :: error
    !
    cubedag_history_entrynum_hx = hx%entrynum(hid,error)
    if (error)  return
  end function cubedag_history_entrynum_hx

  subroutine cubedag_history_tostr(hid,str,error)
    !-------------------------------------------------------------------
    ! Translate the history identifier to the form "ID (NAME)" (e.g.
    ! "12 (NOISE)"
    !-------------------------------------------------------------------
    integer(kind=iden_l), intent(in)    :: hid
    character(len=*),     intent(out)   :: str
    logical,              intent(inout) :: error
    ! Local
    integer(kind=4) :: ni,nc
    integer(kind=entr_k) :: ient
    type(cubedag_history_t), pointer :: hist
    !
    if (hid.eq.code_history_notyetdefined) then
      str = '-- (NOT-YET-DEFINED)'
      return
    endif
    !
    ient = hx%entrynum(hid,error)
    if (error)  return
    hist => cubedag_history_ptr(hx%list(ient)%p,error)
    if (error)  return
    !
    write(str,'(I0)') hid
    if (ient.le.0) then
      ! Valid: root has no history
      return
    elseif (ient.le.hx%n) then
      ni = len_trim(str)
      nc = min(len_trim(hist%command),len(str)-ni-3)
      write(str(ni+1:),'(3A)')  ' (',hist%command(1:nc),')'
    else
      ni = len_trim(str)
      nc = min(7,len(str)-ni-3)
      write(str(ni+1:),'(3A)')  ' (','UNKNOWN',')'
    endif
    !
  end subroutine cubedag_history_tostr

  subroutine cubedag_history_removenode(id,error)
    use cubelist_types
    use cubedag_dag_buffer
    !-------------------------------------------------------------------
    ! Properly remove a DAG node from the history.
    ! This might leave some commands without inputs or without outputs
    !-------------------------------------------------------------------
    integer(kind=iden_l), intent(in)    :: id  ! Node identifier
    logical,              intent(inout) :: error
    ! Local
    class(cubedag_node_object_t), pointer :: object
    class(list_object_t), pointer :: tot
    integer(kind=entr_k) :: ihist
    type(cubedag_history_t), pointer :: hobj
    !
    ! Get the DAG node pointer
    call cubedag_dag_get_object(id,object,error)
    if (error)  return
    tot => object
    !
    ! Get the history node pointer
    ihist = object%node%history
    hobj => cubedag_history_ptr(hx%list(ihist)%p,error)
    if (error)  return
    !
    ! Remove from command which created it
    call hobj%links%outputs%dissociate(tot,error)
    if (error)  return
    !
    ! Remove from commands which used it as input. As of today, there
    ! is no backpointer to these commands (is this really desired?).
    ! Loop inefficiently on all commands:
    do ihist=1,hx%n
      hobj => cubedag_history_ptr(hx%list(ihist)%p,error)
      if (error)  return
      call hobj%links%inputs%dissociate(tot,error)
      if (error)  return
    enddo
    !
  end subroutine cubedag_history_removenode

  subroutine cubedag_history_removecommand(hid,error)
    use cubelist_types
    use cubedag_dag_buffer
    !-------------------------------------------------------------------
    ! Properly a command from the history.
    ! This might leave other commands without inputs and/or without
    ! outputs
    !-------------------------------------------------------------------
    integer(kind=iden_l), intent(in)    :: hid  ! History identifier
    logical,              intent(inout) :: error
    ! Local
    class(cubedag_node_object_t), pointer :: object
    class(list_object_t), pointer :: tot
    integer(kind=entr_k) :: ihist,inode,jhist
    integer(kind=iden_l) :: nodeid
    character(len=mess_l) :: mess
    type(cubedag_history_t), pointer :: hobj,jobj
    character(len=*), parameter :: rname='HISTORY>REMOVECOMMAND'
    !
    ihist = hx%entrynum(hid,error)
    if (error)  return
    hobj => cubedag_history_ptr(hx%list(ihist)%p,error)
    if (error)  return
    write(mess,'(a,i0,3a)')  'Undo command #',ihist,' (',trim(hobj%command),')'
    call cubedag_message(seve%i,rname,mess)
    !
    do inode=1,hobj%links%outputs%n
      object => cubedag_node_ptr(hobj%links%outputs%list(inode)%p,error)
      if (error)  return
      nodeid = object%node%id
      tot => object
      !
      ! Remove from commands which used it as input. As of today, there
      ! is no backpointer to these commands (is this really desired?).
      ! Loop inefficiently on all commands:
      do jhist=1,hx%n
        jobj => cubedag_history_ptr(hx%list(jhist)%p,error)
        if (error)  return
        call jobj%links%inputs%dissociate(tot,error)
        if (error)  return
      enddo
      !
      ! Actually remove the node from DAG
      call cubedag_dag_removenode(nodeid,error)
      if (error)  return
    enddo
    !
    ! Now remove the command from history index
    call hx%pop(ihist,error)
    if (error)  return
  end subroutine cubedag_history_removecommand

  subroutine cubedag_history_destroy(error)
    !-------------------------------------------------------------------
    ! Brute-force destroy the whole HISTORY
    ! No care of the backpointer links to the cubes in the DAG
    !-------------------------------------------------------------------
    logical, intent(inout) :: error
    !
    call hx%final(error)
    if (error)  continue
  end subroutine cubedag_history_destroy

end module cubedag_history_buffer
