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

  type(history_optimize_t), target :: hx  ! History index

  public :: hx
  public :: cubedag_history_add_tohx
  public :: cubedag_history_add_fromhx
  public :: cubedag_history_list_hx
  public :: cubedag_history_tostr
  public :: cubedag_history_removenode,cubedag_history_removecommand
  public :: cubedag_history_destroy
  private

contains

  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,error)
    if (error)  return
    hid = hx%id(hx%next-1)
  end subroutine cubedag_history_add_tohx

  subroutine cubedag_history_add_fromhx(hoptx,hid,error)
    !-------------------------------------------------------------------
    ! Add a command in the given index, duplicating one command from
    ! the main history index
    !-------------------------------------------------------------------
    class(history_optimize_t), intent(inout) :: hoptx
    integer(kind=iden_l),      intent(in)    :: hid
    logical,                   intent(inout) :: error
    ! Local
    integer(kind=entr_k) :: ihist
    !
    ihist = cubedag_history_entrynum(hid,error)
    if (error)  return
    !
    call hoptx%add(  &
      hx%command(ihist),  &
      hx%line(ihist),  &
      hx%inputs(ihist),  &
      hx%outputs(ihist),  &
      error)
    if (error)  return
    !
    ! Beware the ID must be kept from the original index
    hoptx%id(hoptx%next-1) = hx%id(ihist)
  end subroutine cubedag_history_add_fromhx

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

  function cubedag_history_entrynum(id,error)
    !-------------------------------------------------------------------
    ! Resolve the entry number corresponding to the given ID.
    ! - If ID>0, the entry is resolved by searching in all the history
    ! index. This resolution is based on two strong assumptions:
    !  1) the identifier is UNIQUE,
    !  2) the identifier list is SORTED
    ! - If ID<=0, the ID is assumed to be a position from the end
    ! (0=last, same as CubeID).
    !-------------------------------------------------------------------
    integer(kind=entr_k) :: cubedag_history_entrynum
    integer(kind=iden_l), intent(in)    :: id
    logical,              intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='HISTORY>ENTRYNUM'
    integer(kind=entr_k) :: inf,mid,sup
    character(len=mess_l) :: mess
    !
    if (id.le.0) then
      ! Search by position from the end
      if (-id.gt.hx%next-2) then
        write(mess,'(A,I0,A)')  'No such position ',id,' in history'
        call cubedag_message(seve%e,rname,mess)
        cubedag_history_entrynum = 0
        error = .true.
        return
      endif
      cubedag_history_entrynum = hx%next-1+id
      return
    endif
    !
    ! Dichotomic search
    if (hx%id(1).eq.id) then
      cubedag_history_entrynum = 1
      return
    endif
    !
    inf = 1
    sup = hx%next-1
    do while (sup.gt.inf+1)
      mid = (inf+sup)/2  ! Integer division
      if (hx%id(mid).lt.id) then
        inf = mid
      else
        sup = mid
      endif
    enddo
    !
    if (hx%id(sup).eq.id) then
      cubedag_history_entrynum = sup
    else
      write(mess,'(A,I0,A)')  'No such identifier ',id,' in history'
      call cubedag_message(seve%e,rname,mess)
      cubedag_history_entrynum = 0
      error = .true.
      return
    endif
    !
  end function cubedag_history_entrynum

  subroutine cubedag_history_tostr(hid,str,error)
    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
    !
    ient = cubedag_history_entrynum(hid,error)
    if (error)  return
    !
    write(str,'(I0)') hid
    if (ient.le.0) then
      ! Valid: root has no history
      return
    elseif (ient.lt.hx%next) then
      ni = len_trim(str)
      nc = min(len_trim(hx%command(ient)),len(str)-ni-3)
      write(str(ni+1:),'(3A)')  ' (',hx%command(ient)(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 cubedag_dag
    !-------------------------------------------------------------------
    ! 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(tools_object_t), pointer :: tot
    integer(kind=entr_k) :: ihist
    !
    call cubedag_dag_get_object(id,object,error)
    if (error)  return
    ihist = object%node%history
    tot => object
    !
    ! Remove from command which created it
    call hx%outputs(ihist)%unlink(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 unefficiently on all commands:
    do ihist=1,hx%next-1
      call hx%inputs(ihist)%unlink(tot,error)
      if (error)  return
    enddo
    !
  end subroutine cubedag_history_removenode

  subroutine cubedag_history_removecommand(hid,error)
    use cubedag_dag
    !-------------------------------------------------------------------
    ! 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(tools_object_t), pointer :: tot
    integer(kind=entr_k) :: ihist,inode,jhist
    integer(kind=iden_l) :: nodeid
    !
    ihist = cubedag_history_entrynum(hid,error)
    if (error)  return
    !
    do inode=1,hx%outputs(ihist)%n
      object => cubedag_node_ptr(hx%outputs(ihist)%list(inode)%p,error)
      if (error)  return
      nodeid = object%node%id
      call cubedag_dag_get_object(nodeid,object,error)
      if (error)  return
      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 unefficiently on all commands:
      do jhist=1,hx%next-1
        call hx%inputs(jhist)%unlink(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 cubedag_history_removecommand_from(hx,ihist,error)
    if (error)  return
    !
  end subroutine cubedag_history_removecommand

  subroutine cubedag_history_removecommand_from(optx,ihist,error)
    !-------------------------------------------------------------------
    ! Properly remove a command from the history index
    !-------------------------------------------------------------------
    type(history_optimize_t), intent(inout) :: optx
    integer(kind=entr_k),     intent(in)    :: ihist
    logical,                  intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='HISTORY>REMOVE>COMMAND'
    integer(kind=entr_k) :: ient
    !
    call hx%inputs(ihist)%final(error)
    if (error)  return
    call hx%outputs(ihist)%final(error)
    if (error)  return
    !
    do ient=ihist+1,optx%next-1
      optx%id(ient-1)      = optx%id(ient)
      optx%command(ient-1) = optx%command(ient)
      optx%line(ient-1)    = optx%line(ient)
      call optx%inputs(ient)%copy(optx%inputs(ient-1),error)
      if (error)  return
      call optx%outputs(ient)%copy(optx%outputs(ient-1),error)
      if (error)  return
    enddo
    optx%next = optx%next-1
    !
  end subroutine cubedag_history_removecommand_from

  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 cubedag_history_final(hx)
  end subroutine cubedag_history_destroy

  subroutine cubedag_history_final(hoptx)
    !-------------------------------------------------------------------
    ! Finalize the history buffer
    !-------------------------------------------------------------------
    type(history_optimize_t), intent(out) :: hoptx  ! intent(out) invokes FINAL procedure
  end subroutine cubedag_history_final

end module cubedag_history
