Add: backend_output to manage pretty printing of build progress

4 files changed, 203 insertions, 1 deletions

diff --git a/fpm.toml b/fpm.toml
index 7289c82..f3a297c 100644
--- a/fpm.toml
+++ b/fpm.toml
@@ -14,6 +14,11 @@ rev = "2f5eaba864ff630ba0c3791126a3f811b6e437f3"
 git = "https://github.com/urbanjost/M_CLI2.git"
 rev = "ea6bbffc1c2fb0885e994d37ccf0029c99b19f24"
 
+[dependencies.M_attr]
+git = "https://github.com/urbanjost/M_attr.git"
+rev = "608b9d3b40be9ff2590c23d2089781fd4da76344"
+
+
 [[test]]
 name = "cli-test"
 source-dir = "test/cli_test"
diff --git a/src/fpm_backend.f90 b/src/fpm_backend.f90
index 731763f..e0ed972 100644
--- a/src/fpm_backend.f90
+++ b/src/fpm_backend.f90
@@ -35,6 +35,7 @@ use fpm_model, only: fpm_model_t
 use fpm_strings, only: string_t, operator(.in.)
 use fpm_targets, only: build_target_t, build_target_ptr, FPM_TARGET_OBJECT, &
                        FPM_TARGET_C_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE
+use fpm_backend_output
 implicit none
 
 private
@@ -62,6 +63,8 @@ subroutine build_package(targets,model,verbose)
     type(string_t), allocatable :: build_dirs(:)
     type(string_t) :: temp
 
+    type(console_t) :: console
+    integer :: line, n_complete
     logical :: plain_output
 
     ! Need to make output directory for include (mod) files
@@ -92,16 +95,24 @@ subroutine build_package(targets,model,verbose)
     allocate(stat(size(queue)))
     stat(:) = 0
     build_failed = .false.
+    n_complete = 0
 
     ! Set output mode
     plain_output = (.not.(c_isatty()==1)) .or. verbose
+    call console%init(plain_output)
+    call output_init(plain_output)
+
     ! Loop over parallel schedule regions
     do i=1,size(schedule_ptr)-1
 
         ! Build targets in schedule region i
-        !$omp parallel do default(shared) private(skip_current) schedule(dynamic,1)
+        !$omp parallel do default(shared) private(skip_current,line) schedule(dynamic,1)
         do j=schedule_ptr(i),(schedule_ptr(i+1)-1)
 
+            ! Update console output
+            call output_status_compiling(console, line, queue(j)%ptr)
+            call output_progress(n_complete, size(queue),plain_output)
+
             ! Check if build already failed
             !$omp atomic read
             skip_current = build_failed
@@ -116,10 +127,15 @@ subroutine build_package(targets,model,verbose)
                 build_failed = .true.
             end if
 
+            ! Update console output
+            call output_status_complete(console, line, queue(j)%ptr,stat(j), n_complete)
+            call output_progress(n_complete, size(queue),plain_output)
+
         end do
 
         ! Check if this schedule region failed: exit with message if failed
         if (build_failed) then
+            write(*,*) ''
             do j=1,size(stat)
                 if (stat(j) /= 0) then
                     write(stderr,'(*(g0:,1x))') '<ERROR> Compilation failed for object "',basename(queue(j)%ptr%output_file),'"'
@@ -130,6 +146,8 @@ subroutine build_package(targets,model,verbose)
 
     end do
 
+    call output_progress_complete()
+
 end subroutine build_package
 
 
diff --git a/src/fpm_backend_console.f90 b/src/fpm_backend_console.f90
new file mode 100644
index 0000000..4db0cdc
--- /dev/null
+++ b/src/fpm_backend_console.f90
@@ -0,0 +1,82 @@
+module fpm_backend_console

+use iso_fortran_env, only: stdout=>output_unit

+implicit none

+

+private

+public :: console_t

+

+character(len=*), parameter :: ESC = char(27)

+

+type console_t

+    integer :: n_line = 1

+    logical :: plain_mode = .false.

+    character(:), allocatable :: LINE_RESET

+    character(:), allocatable :: LINE_UP

+    character(:), allocatable :: LINE_DOWN

+contains

+    procedure :: init => console_init

+    procedure :: write_line => console_write_line

+    procedure :: update_line => console_update_line

+end type console_t

+

+contains

+

+subroutine console_init(console,plain_mode)

+    class(console_t), intent(out), target :: console

+    logical, intent(in), optional :: plain_mode

+

+    if (present(plain_mode)) then

+        console%plain_mode = plain_mode

+    end if

+

+    if (console%plain_mode) then

+        console%LINE_RESET = ""

+        console%LINE_UP = ""

+        console%LINE_DOWN = ""

+    else

+        console%LINE_RESET = ESC//"[2K"//ESC//"[1G"

+        console%LINE_UP = ESC//"[1A"

+        console%LINE_DOWN = ESC//"[1B"

+    end if

+

+end subroutine console_init

+

+function console_write_line(console,str) result(line)

+    class(console_t), intent(inout), target :: console

+    character(*), intent(in) :: str

+    integer :: line

+

+    !$omp critical

+    line = console%n_line

+

+    write(stdout,*) console%LINE_RESET//str

+

+    console%n_line = console%n_line + 1

+    !$omp end critical

+

+end function console_write_line

+

+subroutine console_update_line(console,line_no,str)

+    class(console_t), intent(in) :: console

+    integer, intent(in) :: line_no

+    character(*), intent(in) :: str

+

+    integer :: n

+

+    !$omp critical

+

+    n = console%n_line - line_no !+ 1 !+ 1

+

+    ! Step back to line

+    write(stdout,'(A)',advance="no") repeat(console%LINE_UP,n)//console%LINE_RESET

+

+    write(stdout,*) str

+

+    ! Step forward to end

+    write(stdout,'(A)',advance="no") repeat(console%LINE_DOWN,n)//console%LINE_RESET

+

+    !$omp end critical

+

+end subroutine console_update_line

+

+end module fpm_backend_console
\ No newline at end of file
diff --git a/src/fpm_backend_output.f90 b/src/fpm_backend_output.f90
new file mode 100644
index 0000000..82c019f
--- /dev/null
+++ b/src/fpm_backend_output.f90
@@ -0,0 +1,97 @@
+module fpm_backend_output

+use iso_fortran_env, only: stdout=>output_unit

+use fpm_filesystem, only: basename

+use fpm_targets, only: build_target_t

+use fpm_backend_console, only: console_t

+use M_attr, only: attr, attr_mode

+implicit none

+

+

+contains

+    

+    subroutine output_init(plain_mode)

+        logical, intent(in), optional :: plain_mode

+        

+        if (plain_mode) then

+            call attr_mode('plain')

+        else

+            call attr_mode('color')

+        end if

+

+    end subroutine output_init

+

+    subroutine output_status_compiling(console, line, target)

+        type(console_t), intent(inout), target :: console

+        integer, intent(inout) :: line

+        type(build_target_t), intent(in) :: target

+

+        character(:), allocatable :: target_name

+        character(100) :: output_string

+

+        if (allocated(target%source)) then

+            target_name = basename(target%source%file_name)

+        else

+            target_name = basename(target%output_file)

+        end if

+

+        write(output_string,'(A,T40,A,A)') target_name,attr('<yellow>compiling...</yellow>')

+

+        line = console%write_line(trim(output_string))

+

+    end subroutine output_status_compiling

+

+    subroutine output_status_complete(console, line, target, build_stat, n_complete)

+        type(console_t), intent(inout), target :: console

+        integer, intent(in) :: line

+        type(build_target_t), intent(in) :: target

+        integer, intent(in) :: build_stat

+        integer, intent(inout) :: n_complete

+

+        character(:), allocatable :: target_name

+        character(100) :: output_string

+

+        if (allocated(target%source)) then

+            target_name = basename(target%source%file_name)

+        else

+            target_name = basename(target%output_file)

+        end if

+

+        if (build_stat == 0) then

+            write(output_string,'(A,T40,A,A)') target_name,attr('<green>done.</green>')

+        else

+            write(output_string,'(A,T40,A,A)') target_name,attr('<red>failed.</red>')

+        end if

+        

+        call console%update_line(line,trim(output_string))

+

+        !$omp critical 

+        n_complete = n_complete + 1

+        !$omp end critical

+

+    end subroutine output_status_complete

+

+    subroutine output_progress(n_complete, total, plain_mode)

+        integer, intent(in) :: n_complete, total

+        logical :: plain_mode

+

+        character(:), allocatable :: advance

+

+        if (plain_mode) then

+            advance = "yes"

+        else

+            advance = "no"

+        end if

+

+        !$omp critical

+        write(*,'(A,I4,A,A)',advance=advance) '[',100*n_complete/total,'%] Compiling project...'

+        !$omp end critical

+

+    end subroutine output_progress

+

+    subroutine output_progress_complete()

+

+        write(*,'(A)') char(27)//"[2K"//char(27)//"[1G"//attr('<green>[100%] Project compiled successfully.</green>')

+

+    end subroutine output_progress_complete

+

+end module fpm_backend_output
\ No newline at end of file