module fpm_os
    use, intrinsic :: iso_c_binding, only: c_char, c_int, c_null_char, c_ptr, c_associated
    use fpm_filesystem, only: exists, join_path, get_home
    use fpm_environment, only: os_is_unix
    use fpm_error, only: error_t, fatal_error

    implicit none
    private
    public :: change_directory, get_current_directory, get_absolute_path, convert_to_absolute_path, &
            & get_absolute_path_by_cd

    integer(c_int), parameter :: buffersize = 1000_c_int

#ifndef _WIN32
    character(len=*), parameter :: pwd_env = "PWD"
#else
    character(len=*), parameter :: pwd_env = "CD"
#endif

    interface
        function chdir_(path) result(stat) &
#ifndef _WIN32
            bind(C, name="chdir")
#else
            bind(C, name="_chdir")
#endif
            import :: c_char, c_int
            character(kind=c_char, len=1), intent(in) :: path(*)
            integer(c_int) :: stat
        end function chdir_

        function getcwd_(buf, bufsize) result(path) &
#ifndef _WIN32
            bind(C, name="getcwd")
#else
            bind(C, name="_getcwd")
#endif
            import :: c_char, c_int, c_ptr
            character(kind=c_char, len=1), intent(in) :: buf(*)
            integer(c_int), value, intent(in) :: bufsize
            type(c_ptr) :: path
        end function getcwd_

        !> Determine the absolute, canonicalized path for a given path. Unix-only.
        function realpath(path, resolved_path) result(ptr) bind(C)
            import :: c_ptr, c_char, c_int
            character(kind=c_char, len=1), intent(in) :: path(*)
            character(kind=c_char, len=1), intent(out) :: resolved_path(*)
            type(c_ptr) :: ptr
        end function realpath

        !> Determine the absolute, canonicalized path for a given path. Windows-only.
        function fullpath(resolved_path, path, maxLength) result(ptr) bind(C, name="_fullpath")
            import :: c_ptr, c_char, c_int
            character(kind=c_char, len=1), intent(in) :: path(*)
            character(kind=c_char, len=1), intent(out) :: resolved_path(*)
            integer(c_int), value, intent(in) :: maxLength
            type(c_ptr) :: ptr
        end function fullpath

        !> Determine the absolute, canonicalized path for a given path.
        !> Calls custom C routine because the `_WIN32` macro is correctly exported
        !> in C using `gfortran`.
        function c_realpath(path, resolved_path, maxLength) result(ptr) &
            bind(C, name="c_realpath")
            import :: c_ptr, c_char, c_int
            character(kind=c_char, len=1), intent(in) :: path(*)
            character(kind=c_char, len=1), intent(out) :: resolved_path(*)
            integer(c_int), value, intent(in) :: maxLength
            type(c_ptr) :: ptr
        end function c_realpath
    end interface

contains

    subroutine change_directory(path, error)
        character(len=*), intent(in) :: path
        type(error_t), allocatable, intent(out) :: error

        character(kind=c_char, len=1), allocatable :: cpath(:)
        integer :: stat

        allocate (cpath(len(path) + 1))
        call f_c_character(path, cpath, len(path) + 1)

        stat = chdir_(cpath)

        if (stat /= 0) then
            call fatal_error(error, "Failed to change directory to '"//path//"'")
        end if
    end subroutine change_directory

    subroutine get_current_directory(path, error)
        character(len=:), allocatable, intent(out) :: path
        type(error_t), allocatable, intent(out) :: error

        character(kind=c_char, len=1), allocatable :: cpath(:)
        type(c_ptr) :: tmp

        allocate (cpath(buffersize))

        tmp = getcwd_(cpath, buffersize)
        if (c_associated(tmp)) then
            call c_f_character(cpath, path)
        else
            call fatal_error(error, "Failed to retrieve current directory")
        end if

    end subroutine get_current_directory

    subroutine f_c_character(rhs, lhs, len)
        character(kind=c_char), intent(out) :: lhs(*)
        character(len=*), intent(in) :: rhs
        integer, intent(in) :: len
        integer :: length
        length = min(len - 1, len_trim(rhs))

        lhs(1:length) = transfer(rhs(1:length), lhs(1:length))
        lhs(length + 1:length + 1) = c_null_char

    end subroutine f_c_character

    subroutine c_f_character(rhs, lhs)
        character(kind=c_char), intent(in) :: rhs(*)
        character(len=:), allocatable, intent(out) :: lhs

        integer :: ii

        do ii = 1, huge(ii) - 1
            if (rhs(ii) == c_null_char) then
                exit
            end if
        end do

        allocate (character(len=ii - 1) :: lhs)
        lhs = transfer(rhs(1:ii - 1), lhs)

    end subroutine c_f_character

    !> Determine the canonical, absolute path for the given path.
    !>
    !> Calls a C routine that uses the `_WIN32` macro to determine the correct function.
    !>
    !> Cannot be used in bootstrap mode.
    subroutine get_realpath(path, real_path, error)
        character(len=*), intent(in) :: path
        character(len=:), allocatable, intent(out) :: real_path
        type(error_t), allocatable, intent(out) :: error

        character(kind=c_char, len=1), allocatable :: appended_path(:)
        character(kind=c_char, len=1), allocatable :: cpath(:)
        type(c_ptr) :: ptr

        if (.not. exists(path)) then
            call fatal_error(error, "Cannot determine absolute path. Path '"//path//"' does not exist.")
            return
        end if

        allocate (appended_path(len(path) + 1))
        call f_c_character(path, appended_path, len(path) + 1)

        allocate (cpath(buffersize))

#ifndef FPM_BOOTSTRAP
        ptr = c_realpath(appended_path, cpath, buffersize)
#endif

        if (c_associated(ptr)) then
            call c_f_character(cpath, real_path)
        else
            call fatal_error(error, "Failed to retrieve absolute path for '"//path//"'.")
        end if

    end subroutine

    !> Determine the canonical, absolute path for the given path.
    !> Expands home folder (~) on both Unix and Windows.
    subroutine get_absolute_path(path, absolute_path, error)
        character(len=*), intent(in) :: path
        character(len=:), allocatable, intent(out) :: absolute_path
        type(error_t), allocatable, intent(out) :: error

        character(len=:), allocatable :: home

#ifdef FPM_BOOTSTRAP
        call get_absolute_path_by_cd(path, absolute_path, error); return
#endif

        if (len_trim(path) < 1) then
            call fatal_error(error, 'Path cannot be empty'); return
        else if (path(1:1) == '~') then
            call get_home(home, error)
            if (allocated(error)) return

            if (len_trim(path) == 1) then
                absolute_path = home; return
            end if

            if (os_is_unix()) then
                if (path(2:2) /= '/') then
                    call fatal_error(error, "Wrong separator in path: '"//path//"'"); return
                end if
            else
                if (path(2:2) /= '\') then
                    call fatal_error(error, "Wrong separator in path: '"//path//"'"); return
                end if
            end if

            if (len_trim(path) == 2) then
                absolute_path = home; return
            end if

            absolute_path = join_path(home, path(3:len_trim(path)))

            if (.not. exists(absolute_path)) then
                call fatal_error(error, "Path not found: '"//absolute_path//"'"); return
            end if
        else
            ! Get canonicalized absolute path from either the absolute or the relative path.
            call get_realpath(path, absolute_path, error)
        end if
    end subroutine

    !> Alternative to `get_absolute_path` that uses `chdir`/`_chdir` to determine the absolute path.
    !>
    !> `get_absolute_path` is preferred but `get_absolute_path_by_cd` can be used in bootstrap mode.
    subroutine get_absolute_path_by_cd(path, absolute_path, error)
        character(len=*), intent(in) :: path
        character(len=:), allocatable, intent(out) :: absolute_path
        type(error_t), allocatable, intent(out) :: error

        character(len=:), allocatable :: current_path

        call get_current_directory(current_path, error)
        if (allocated(error)) return

        call change_directory(path, error)
        if (allocated(error)) return

        call get_current_directory(absolute_path, error)
        if (allocated(error)) return

        call change_directory(current_path, error)
        if (allocated(error)) return
    end subroutine

    !> Converts a path to an absolute, canonical path.
    subroutine convert_to_absolute_path(path, error)
        character(len=:), allocatable, intent(inout) :: path
        type(error_t), allocatable, intent(out) :: error

        character(len=:), allocatable :: absolute_path

        call get_absolute_path(path, absolute_path, error)
        path = absolute_path
    end subroutine

end module fpm_os
