module cubetools_realpath
  use gkernel_interfaces
  use cubetools_parameters
  !---------------------------------------------------------------------
  ! This module offers the possibility to
  ! 1) convert a relative path and symlinks to absolute real path,
  ! 2) compute the relative path from one absolute path to another
  !---------------------------------------------------------------------

  public :: cubetools_realpath_t
  private

  character(len=1), parameter :: dirsep='/'       ! ZZZ Should use subroutine gag_separ
  integer(kind=4),  parameter :: notyetparsed=-1  !

  type :: cubetools_realpath_t
    character(len=file_l), private :: path      ! Original path
    integer(kind=4),       private :: np        ! Useful size of path
    character(len=file_l), private :: realpath  ! Resolved path
    integer(kind=4),       private :: nrp       ! Useful size of realpath
    integer(kind=4),       private :: sep(32)   ! Position of directory separators
    integer(kind=4),       private :: nsep      ! Number of separators
  contains
    procedure, public  :: resolve      => path_resolve
    procedure, private :: parse        => path_parse
    procedure, public  :: relativeto   => path_relativeto
    procedure, public  :: absolutefrom => path_absolutefrom
  end type cubetools_realpath_t

contains
  subroutine path_resolve(a,path)
    use, intrinsic :: iso_c_binding
    !-------------------------------------------------------------------
    ! Invoke C realpath on the given path
    ! Note that files (or directories?) do not need to exist to resolve
    ! them as full paths.
    !-------------------------------------------------------------------
    class(cubetools_realpath_t), intent(inout) :: a
    character(len=*),            intent(in)    :: path

    type(c_ptr) :: ptr

    ! Fortran interface to C function, realpath()
    interface
      function realpath(path,resolved_path) bind(c)
      use, intrinsic :: iso_c_binding
      type(c_ptr) :: realpath
      character(len=1,kind=c_char), intent(in)  :: path(*)
      character(len=1,kind=c_char), intent(out) :: resolved_path(*)
      end function realpath
    end interface

    a%np       = len_trim(path)
    a%path     = path(1:a%np)//char(0)
    a%realpath = ''  ! Pre-fill output with blanks
    ptr        = realpath(a%path,a%realpath)  ! Pass long scalars to a len=1 arrays (ok in standard)
    a%nrp      = lenc(a%realpath)
    a%nsep     = notyetparsed
    ! print *,a%realpath(1:a%nrp)
  end subroutine path_resolve

  subroutine path_parse(a)
    !-------------------------------------------------------------------
    ! Compute where the directory separators are located and save this
    ! in the type.
    !-------------------------------------------------------------------
    class(cubetools_realpath_t), intent(inout) :: a
    !
    integer(kind=4) :: i
    !
    if (a%nsep.ne.notyetparsed)  return
    !
    a%nsep = 0
    do i=1,a%nrp
      if (a%realpath(i:i).eq.dirsep) then
        a%nsep = a%nsep+1
        a%sep(a%nsep) = i
      endif
    enddo
    !
    ! Assume a pseudo-separator at the end if path is directory. This
    ! will ensure that path_relativeto works properly, relatively from
    ! files or from directories
    if (gag_isdir(a%realpath).eq.0) then
      a%nsep = a%nsep+1
      a%sep(a%nsep) = a%nrp+1
    endif
  end subroutine path_parse

  function path_relativeto(a,b)
    !-------------------------------------------------------------------
    ! Compute the path of a relative to b
    !-------------------------------------------------------------------
    character(len=file_l) :: path_relativeto  ! Function value on return
    class(cubetools_realpath_t), intent(inout) :: a
    type(cubetools_realpath_t),  intent(inout) :: b
    !
    integer(kind=4) :: commonsep,isep,nc
    !
    ! Leave absolute paths as absolute
    if (a%path(1:1).eq.dirsep) then
      path_relativeto = a%path(1:a%np)
      return
    endif
    !
    ! Parse separators
    call a%parse()
    call b%parse()
    !
    ! Find common separator
    commonsep = 1
    do isep=2,a%nsep
      if (isep.gt.b%nsep)  exit
      if (a%realpath(a%sep(isep-1)+1:a%sep(isep)-1).ne. &
          b%realpath(b%sep(isep-1)+1:b%sep(isep)-1)) then
        exit
      endif
      commonsep = isep
    enddo
    ! print *,"Common separator is ",commonsep,' at position ',a%sep(commonsep)
    !
    if (commonsep.le.3) then
      ! Most likely only /home/user/ in common: makes poor sense to
      ! produce a relative path
      path_relativeto = a%realpath(1:a%nrp)
    else
      path_relativeto = ''
      nc = 0
      do isep=commonsep+1,b%nsep
        path_relativeto(nc+1:nc+3) = '..'//dirsep
        nc = nc+3
      enddo
      path_relativeto(nc+1:) = a%realpath(a%sep(commonsep)+1:a%nrp)
    endif
    ! print *,"Relative path is ",trim(relpath)
  end function path_relativeto

  subroutine path_absolutefrom(a,file,path)
    !-------------------------------------------------------------------
    ! Set up the absolute realpath of file 'file' hosted in directory
    ! 'path'. The file name can be a simple file name, a file name with
    ! a relative path, or an absolute path (in this latter case, 'path'
    ! is obviously not relevant.
    !-------------------------------------------------------------------
    class(cubetools_realpath_t), intent(inout) :: a
    character(len=*),            intent(in)    :: file,path
    !
    if (file(1:1).eq.dirsep) then
      ! Leave absolute paths as absolute
      call a%resolve(file)
    else
      ! File has no path, or a relative path from 'path'
      call a%resolve(trim(path)//dirsep//file)
    endif
  end subroutine path_absolutefrom
end module cubetools_realpath
