From 5855337167b53abcaa17452ea1c3c048acb34e09 Mon Sep 17 00:00:00 2001
From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com>
Date: Thu, 27 May 2021 21:40:35 +0200
Subject: Automatically search for package manifest

---
 app/main.f90 | 77 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 77 insertions(+)

(limited to 'app')

diff --git a/app/main.f90 b/app/main.f90
index 7476df6..5600f98 100644
--- a/app/main.f90
+++ b/app/main.f90
@@ -1,4 +1,5 @@
 program main
+use, intrinsic :: iso_fortran_env, only : error_unit, output_unit
 use fpm_command_line, only: &
         fpm_cmd_settings, &
         fpm_new_settings, &
@@ -8,17 +9,57 @@ use fpm_command_line, only: &
         fpm_install_settings, &
         fpm_update_settings, &
         get_command_line_settings
+use fpm_error, only: error_t
+use fpm_filesystem, only: exists, parent_dir, join_path
 use fpm, only: cmd_build, cmd_run
 use fpm_cmd_install, only: cmd_install
 use fpm_cmd_new, only: cmd_new
 use fpm_cmd_update, only : cmd_update
+use fpm_os,  only: change_directory, get_current_directory
 
 implicit none
 
 class(fpm_cmd_settings), allocatable :: cmd_settings
+type(error_t), allocatable :: error
+character(len=:), allocatable :: pwd_start, pwd_working, working_dir, project_root
 
 call get_command_line_settings(cmd_settings)
 
+call get_current_directory(pwd_start, error)
+call handle_error(error)
+
+call get_working_dir(cmd_settings, working_dir)
+if (allocated(working_dir)) then
+    ! Change working directory if requested
+    if (len_trim(working_dir) > 0) then
+        call change_directory(working_dir, error)
+        call handle_error(error)
+
+        call get_current_directory(pwd_working, error)
+        call handle_error(error)
+        write(output_unit, '(*(a))') "fpm: Entering directory '"//pwd_working//"'"
+    else
+        pwd_working = pwd_start
+    end if
+else
+    pwd_working = pwd_start
+end if
+
+if (.not.has_manifest(pwd_working)) then
+    project_root = pwd_working
+    do while(.not.has_manifest(project_root))
+        working_dir = parent_dir(project_root)
+        if (len(working_dir) == 0) exit
+        project_root = working_dir
+    end do
+
+    if (has_manifest(project_root)) then
+        call change_directory(project_root, error)
+        call handle_error(error)
+        write(output_unit, '(*(a))') "fpm: Entering directory '"//project_root//"'"
+    end if
+end if
+
 select type(settings=>cmd_settings)
 type is (fpm_new_settings)
     call cmd_new(settings)
@@ -34,4 +75,40 @@ type is (fpm_update_settings)
     call cmd_update(settings)
 end select
 
+if (allocated(project_root)) then
+    write(output_unit, '(*(a))') "fpm: Leaving directory '"//project_root//"'"
+end if
+
+if (pwd_start /= pwd_working) then
+    write(output_unit, '(*(a))') "fpm: Leaving directory '"//pwd_working//"'"
+end if
+
+contains
+
+    function has_manifest(dir)
+        character(len=*), intent(in) :: dir
+        logical :: has_manifest
+
+        character(len=:), allocatable :: manifest
+
+        has_manifest = exists(join_path(dir, "fpm.toml"))
+    end function has_manifest
+
+    subroutine handle_error(error)
+        type(error_t), optional, intent(in) :: error
+        if (present(error)) then
+            write(error_unit, '("[Error]", 1x, a)') error%message
+            stop 1
+        end if
+    end subroutine handle_error
+
+    !> Save access to working directory in settings, in case setting have not been allocated
+    subroutine get_working_dir(settings, working_dir)
+        class(fpm_cmd_settings), optional, intent(in) :: settings
+        character(len=:), allocatable, intent(out) :: working_dir
+        if (present(settings)) then
+            working_dir = settings%working_dir
+        end if
+    end subroutine get_working_dir
+
 end program main
-- 
cgit v1.2.3