module fpm_os
    use, intrinsic :: iso_c_binding, only : c_char, c_int, c_null_char, c_ptr, c_associated
    use fpm_error, only : error_t, fatal_error
    implicit none
    private
    public :: change_directory, get_current_directory, windows_is_wow64

#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
    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(:)
        integer(c_int), parameter :: buffersize = 1000_c_int
        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
    
#ifdef _WIN32
    function windows_is_wow64() result(wow64)
    use iso_c_binding
    implicit none 
        
        logical(kind=c_bool), target::wow64

        ! If compiled for 64-bit, then the answer is no
#ifndef __i386__

        wow64 = .false.

#else

        interface
            function IsWow64Process(h, cptrbool)
            type(c_ptr), value::h, cptrbool
            logical(kind=c_bool)::IsWow64Process
            end function IsWow64Process
        end interface
        
        interface 
            function GetModuleHandle(str) bind(c)
            character(len=*, kind=c_char)::str
            type(c_ptr)::GetModuleHandle
            end function GetModuleHandle
        end interface
        
        interface
            function GetProcAddress(libptr, str) bind(c)
            type(c_ptr), value::libptr
            character(len=*, kind=c_char)::str
            type(c_funptr)::GetProcAddress
            end function GetProcAddress
        end interface
        
        interface
            function GetCurrentProcess() bind(c)
            type(c_ptr)::GetCurrentProcess
            end function GetCurrentProcess
        end interface
        
        type(c_funptr)::wow64_c
        procedure(IsWow64Process), pointer::wow64_f
        
        
        wow64_c = GetProcAddress( &
            GetModuleHandle("kernel32"//c_null_char), &
            "IsWow64Process"//c_null_char)
        
        if(wow64_c == c_null_funptr) then
            wow64 = .false.
        else
            call c_f_procpointer(wow64_c, wow64_f)
            if(.not. wow64_f(GetCurrentProcess(), c_loc(wow64))) then
                wow64 = .false.
            end if
        end if
#endif 

    end function windows_is_wow64
    
#else

    ! Non-windows systems...
    function windows_is_wow64() 
    implicit none 
        logical::windows_is_wow64
        windows_is_wow64 = .false.
    end function windows_is_wow64

#endif

end module fpm_os