module cubedag_hrepository
  use gkernel_interfaces
  use cubetools_parameters
  use cubedag_parameters
  use cubedag_messaging
  use cubedag_history
  use cubedag_dag

  character(len=*), parameter :: form_i8='(A,T13,I20)'
  character(len=*), parameter :: form_a='(A,T13,A)'                  ! Scalar string

  public :: cubedag_hrepository_init,cubedag_hrepository_write,cubedag_hrepository_read
  private

contains

  subroutine cubedag_hrepository_init(path,error)
    !-------------------------------------------------------------------
    ! Initialize a new repository
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: path
    logical,          intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='HREPOSITORY>INIT'
    !
    ! Create and init new one on disk
    ! ZZZ Not yet implemented
    !
  end subroutine cubedag_hrepository_init

  !---------------------------------------------------------------------

  subroutine cubedag_hrepository_open(name,read,lun,error)
    character(len=*), intent(in)    :: name
    logical,          intent(in)    :: read
    integer(kind=4),  intent(out)   :: lun
    logical,          intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='HREPOSITORY>OPEN'
    character(len=3) :: mode
    integer(kind=4) :: ier
    !
    if (read) then
      mode = 'OLD'
    else
      call cubedag_message(seve%i,rname,'Creating history repository in file '//name)
      mode = 'NEW'
    endif
    !
    ier = sic_getlun(lun)
    if (mod(ier,2).eq.0) then
      error = .true.
      return
    endif
    ier = sic_open(lun,name,mode,.false.)
    if (ier.ne.0) then
      call cubedag_message(seve%e,rname,'Error opening file '//name)
      call putios('E-SIC, ',ier)
      error = .true.
      return
    endif
  end subroutine cubedag_hrepository_open

  subroutine cubedag_hrepository_close(lun,error)
    integer(kind=4),  intent(in)   :: lun
    logical,          intent(inout) :: error
    ! Local
    integer(kind=4) :: ier
    !
    ier = sic_close(lun)
    call sic_frelun(lun)
  end subroutine cubedag_hrepository_close

  subroutine cubedag_hrepository_write(reponame,error)
    character(len=*), intent(in)    :: reponame
    logical,          intent(inout) :: error
    ! Local
    integer(kind=entr_k) :: ient
    integer(kind=4) :: lun
    !
    call cubedag_hrepository_open(reponame,.false.,lun,error)
    if (error)  return
    !
    do ient=1,hx%next-1  ! Skip root on purpose
      call cubedag_write_entry(lun,ient,error)
      if (error)  return
    enddo
    !
    call cubedag_hrepository_close(lun,error)
    if (error)  return
  end subroutine cubedag_hrepository_write

  subroutine cubedag_write_entry(lun,ient,error)
    integer(kind=4),      intent(in)    :: lun
    integer(kind=entr_k), intent(in)    :: ient
    logical,              intent(inout) :: error
    !
    call cubedag_write_entry_head(lun,ient,error)
    if (error)  return
    call cubedag_write_entry_links(lun,ient,error)
    if (error)  return
  end subroutine cubedag_write_entry

  subroutine cubedag_write_entry_head(lun,ient,error)
    integer(kind=4),      intent(in)    :: lun
    integer(kind=entr_k), intent(in)    :: ient
    logical,              intent(inout) :: error
    !
    write(lun,form_i8) 'ID',hx%id(ient)
    write(lun,form_a)  'COMMAND',trim(hx%command(ient))
    write(lun,form_a)  'LINE',trim(hx%line(ient))
  end subroutine cubedag_write_entry_head

  subroutine cubedag_write_entry_links(lun,ient,error)
    integer(kind=4),      intent(in)    :: lun
    integer(kind=entr_k), intent(in)    :: ient
    logical,              intent(inout) :: error
    !
    call hx%inputs(ient)%write(lun,'INPUTS',error)
    if (error)  return
    call hx%outputs(ient)%write(lun,'OUTPUTS',error)
    if (error)  return
  end subroutine cubedag_write_entry_links

  !---------------------------------------------------------------------

  subroutine cubedag_hrepository_read(reponame,error)
    character(len=*), intent(in)    :: reponame
    logical,          intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='HREPOSITORY>READ'
    character(len=mess_l) :: mess
    integer(kind=4) :: lun
    logical :: nomore
    integer(kind=entr_k) :: ient
    !
    ! Sanity
    if (hx%next.ge.3) then
      ! This would be possible, but this implies renumbering the identifiers
      ! Might be easy by adding a shift (e.g. highest current id) to all
      ! ids/parents/children of the DAG to be imported. But what about overlaps
      ! (i.e. cubes appearing in 2 DAGs at the same time?)
      call cubedag_message(seve%e,rname,'Can not import in a non-empty history')
      error = .true.
      return
    endif
    !
    call cubedag_hrepository_open(reponame,.true.,lun,error)
    if (error)  return
    !
    nomore = .false.
    do
      call cubedag_read_entry(lun,nomore,error)
      if (error)  return
      if (nomore)  exit
    enddo
    !
    ! Post-read: resolve all the links (from IDs to pointers)
    do ient=1,hx%next-1
      call cubedag_hrepo_resolve(ient,error)
      if (error)  return
    enddo
    !
    ! Feedback
    write(mess,'(A,I0,A)')  'Loaded an history index of ',hx%next-1,' commands'
    call cubedag_message(seve%i,rname,mess)
    !
    call cubedag_hrepository_close(lun,error)
    if (error)  return
    !
  end subroutine cubedag_hrepository_read

  subroutine cubedag_read_entry(lun,nomore,error)
    integer(kind=4), intent(in)    :: lun
    logical,         intent(inout) :: nomore
    logical,         intent(inout) :: error
    ! Local
    integer(kind=entr_k) :: ient
    !
    call cubedag_read_entry_head(lun,ient,nomore,error)
    if (error)  return
    if (nomore)  return
    call cubedag_read_entry_links(lun,ient,error)
    if (error)  return
  end subroutine cubedag_read_entry

  subroutine cubedag_read_entry_head(lun,ient,nomore,error)
    integer(kind=4),      intent(in)    :: lun
    integer(kind=entr_k), intent(out)   :: ient
    logical,              intent(inout) :: nomore
    logical,              intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='HREPOSITORY>READ'
    character(len=12) :: key
    integer(kind=iden_l) :: hid
    integer(kind=4) :: ier
    !
    read(lun,form_i8,iostat=ier) key,hid
    if (ier.lt.0) then
      ! EOF
      nomore = .true.
      return
    endif
    if (ier.gt.0) then
      call putios('E-HREPOSITORY,  ',ier)
      error = .true.
      return
    endif
    if (key.ne.'ID') then
      call cubedag_message(seve%e,rname,'Malformatted file: got '//trim(key))
      error = .true.
      return
    endif
    !
    call cubedag_history_reallocate_expo(hx,hx%next,error)
    if (error)  return
    !
    ient = hx%next
    hx%id(ient) = hid
    read(lun,form_a) key,hx%command(ient)
    read(lun,form_a) key,hx%line(ient)
    hx%next = hx%next+1
  end subroutine cubedag_read_entry_head

  subroutine cubedag_read_entry_links(lun,ient,error)
    integer(kind=4),      intent(in)    :: lun
    integer(kind=entr_k), intent(in)    :: ient
    logical,              intent(inout) :: error
    !
    call hx%inputs(ient)%read(lun,error)
    if (error)  return
    call hx%outputs(ient)%read(lun,error)
    if (error)  return
  end subroutine cubedag_read_entry_links

  !---------------------------------------------------------------------

  subroutine cubedag_hrepo_resolve(ient,error)
    !-------------------------------------------------------------------
    ! Resolve all the cross-links (from IDs to pointer) for the given
    ! object.
    !-------------------------------------------------------------------
    integer(kind=entr_k), intent(in)    :: ient
    logical,              intent(inout) :: error
    !
    call cubedag_link_resolve(hx%inputs(ient),error)
    if (error)  return
    call cubedag_link_resolve(hx%outputs(ient),error)
    if (error)  return
    !
  end subroutine cubedag_hrepo_resolve

end module cubedag_hrepository
