module cubedag_remove
  use cubetools_structure
  use cubetools_keywordlist_types
  use cubedag_parameters
  use cubedag_allflags
  use cubeadm_cubeid_types
  use cubedag_messaging
  !
  public :: remove
  private
  !
  type :: remove_comm_t
    type(option_t),      pointer :: comm
    type(cubeid_arg_t),  pointer :: node
    type(option_t),      pointer :: index
    type(keywordlist_comm_t), pointer :: index_arg
  contains
    procedure, public  :: register => cubedag_remove_register
    procedure, private :: parse    => cubedag_remove_parse
    procedure, private :: main     => cubedag_remove_main
  end type remove_comm_t
  type(remove_comm_t) :: remove
  !
  type remove_user_t
    type(cubeid_user_t)   :: cubeids
    logical               :: doindex
    character(len=argu_l) :: index
  contains
    procedure, private :: toprog => cubedag_remove_user_toprog
  end type remove_user_t
  !
  type remove_prog_t
    integer(kind=iden_l) :: id
    integer(kind=code_k) :: index
  contains
    procedure, private :: do => cubedag_remove_do
  end type remove_prog_t
  !
contains
  !
  subroutine cubedag_remove_command(line,error)
    !-------------------------------------------------------------------
    ! Support routine for command REMOVE
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(remove_user_t) :: user
    character(len=*), parameter :: rname='REMOVE>COMMAND'
    !
    call cubedag_message(dagseve%trace,rname,'Welcome')
    !
    call remove%parse(line,user,error)
    if (error) return
    call remove%main(user,error)
    if (error) return
  end subroutine cubedag_remove_command
  !
  subroutine cubedag_remove_register(remove,error)
    !-------------------------------------------------------------------
    ! Register ADM\REMOVE command and its options
    !-------------------------------------------------------------------
    class(remove_comm_t), intent(in)    :: remove
    logical,              intent(inout) :: error
    !
    type(cubeid_arg_t) :: cubearg
    type(keywordlist_comm_t) :: keyarg
    character(len=*), parameter :: rname='REMOVE>REGISTER'
    !
    call cubedag_message(dagseve%trace,rname,'Welcome')
    !
    ! Command
    call cubetools_register_command(&
         'REMOVE','[CubeID]',&
         'Remove a cube from the DAG',&
         strg_emp,&
         cubedag_remove_command,&
         remove%comm,error)
    if (error) return
    call cubearg%register( &
         'CUBE', &
         '[CubeID]',  &
         strg_emp,&
         code_arg_optional,  &
         [flag_any], &
         code_read_none,&  ! Header not needed
         code_access_any,&
         remove%node,&
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'INDEX','[IndexName]',&
         'Remove all cubes from default or named index',&
         strg_emp,&
         remove%index,error)
    if (error) return
    call keyarg%register( &
         'IndexName',  &
         'Name of the index to be removed', &
         'If absent, default index is used.',&
         code_arg_optional, &
         indexname, &
         .not.flexible, &
         remove%index_arg,&
         error)
    if (error) return
  end subroutine cubedag_remove_register
  !
  subroutine cubedag_remove_parse(remove,line,user,error)
    use cubetools_disambiguate
    !-------------------------------------------------------------------
    ! Parsing facility for command
    !   REMOVE CubeID
    !-------------------------------------------------------------------
    class(remove_comm_t), intent(in)    :: remove
    character(len=*),     intent(in)    :: line
    type(remove_user_t),  intent(out)   :: user
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='REMOVE>PARSE'
    !
    call cubedag_message(dagseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,remove%comm,user%cubeids,error)
    if (error) return
    !
    call remove%index%present(line,user%doindex,error)
    if (error) return
    if (user%doindex .and. remove%comm%getnarg().ge.1) then
      call cubedag_message(seve%e,rname,  &
          'Option /INDEX is incompatible with a named cube passed to command')
      error = .true.
      return
    endif
    if (remove%index%getnarg().ge.1) then
      call cubetools_getarg(line,remove%index,1,user%index,mandatory,error)
      if (error) return
    else
      user%index = ''
    endif
  end subroutine cubedag_remove_parse
  !
  subroutine cubedag_remove_main(remove,user,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(remove_comm_t), intent(in)    :: remove
    type(remove_user_t),  intent(in)    :: user
    logical,              intent(inout) :: error
    !
    type(remove_prog_t) :: prog
    character(len=*), parameter :: rname='REMOVE>MAIN'
    !
    call cubedag_message(dagseve%trace,rname,'Welcome')
    !
    call user%toprog(remove,prog,error)
    if (error) return
    call prog%do(error)
    if (error) return
  end subroutine cubedag_remove_main
  !
  !---------------------------------------------------------------------
  !
  subroutine cubedag_remove_user_toprog(user,comm,prog,error)
    use cubetools_setup_types
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(remove_user_t), intent(in)    :: user
    type(remove_comm_t),  intent(in)    :: comm
    type(remove_prog_t),  intent(out)   :: prog
    logical,              intent(inout) :: error
    !
    type(cube_setup_api_t) :: setup
    character(len=argu_l) :: key
    character(len=*), parameter :: rname='REMOVE>USER>TOPROG'
    !
    call cubedag_message(dagseve%trace,rname,'Welcome')
    !
    call cubedag_cubeid_user2prog_one(remove%node,user%cubeids%cube(1),prog%id,error)
    if (error) return
    !
    if (user%doindex) then
      if (user%index.eq.'') then
        call setup%index%default%get(prog%index)
      else
        call cubetools_keywordlist_user2prog(comm%index_arg,user%index,prog%index,key,error)
        if (error) return
      endif
    else
      prog%index = code_null
    endif
  end subroutine cubedag_remove_user_toprog
  !
  subroutine cubedag_remove_do(prog,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(remove_prog_t), intent(inout) :: prog
    logical,              intent(inout) :: error
    !
    if (prog%index.ne.code_null) then
      call cubedag_remove_index(prog,error)
      if (error)  return
    else
      call cubedag_remove_node(prog%id,error)
      if (error)  return
    endif
  end subroutine cubedag_remove_do
  !
  subroutine cubedag_remove_index(prog,error)
    use cubedag_find_types
    use cubedag_link_type
    use cubedag_node_class
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    type(remove_prog_t), intent(in)    :: prog
    logical,             intent(inout) :: error
    !
    type(dag_find_t) :: find
    type(cubedag_link_t) :: optx
    integer(kind=entr_k) :: inode
    class(cubedag_node_object_t), pointer :: dno
    character(len=*), parameter :: rname='REMOVE>INDEX'
    !
    call cubedag_message(dagseve%trace,rname,'Welcome')
    !
    select case (prog%index)
    case (code_index_dag)
      call find%ix2optx(optx,error)
      if (error)  return
    case (code_index_current)
      call find%cx2optx(optx,error)
      if (error)  return
    case default
      call cubedag_message(seve%e,rname,'Index is not supported')
      error = .true.
      return
    end select
    !
    do inode=optx%n,1,-1
      dno => cubedag_node_ptr(optx%list(inode)%p,error)
      if (error) return
      call cubedag_remove_node(dno%get_id(),error)
      if (error)  return
    enddo
  end subroutine cubedag_remove_index
  !
  subroutine cubedag_remove_node(id,error)
    use cubedag_history_buffer
    use cubedag_dag_buffer
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    integer(kind=4), intent(in)    :: id
    logical,         intent(inout) :: error
    !
    character(len=*), parameter :: rname='REMOVE>NODE'
    !
    call cubedag_message(dagseve%trace,rname,'Welcome')
    !
    ! Unreference from history
    call cubedag_history_removenode(id,error)
    if (error) return
    ! Remove it from DAG
    call cubedag_dag_removenode(id,error)
    if (error) return
  end subroutine cubedag_remove_node
end module cubedag_remove
