From bfd9b06249814ad7c4bc47c0f065d6337f87076c Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 16:13:01 +0000 Subject: Add: backend_output to manage pretty printing of build progress --- src/fpm_backend_output.f90 | 97 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 97 insertions(+) create mode 100644 src/fpm_backend_output.f90 (limited to 'src/fpm_backend_output.f90') 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('compiling...') + + 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('done.') + else + write(output_string,'(A,T40,A,A)') target_name,attr('failed.') + 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('[100%] Project compiled successfully.') + + end subroutine output_progress_complete + +end module fpm_backend_output \ No newline at end of file -- cgit v1.2.3 From 37ba9d7cf61d6b9ddbfe59a4456311fda62ef101 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Fri, 26 Nov 2021 17:32:07 +0000 Subject: Simplify implementation and cleanup plain mode output --- src/fpm_backend_output.f90 | 157 ++++++++++++++++++++++++++++++--------------- 1 file changed, 107 insertions(+), 50 deletions(-) (limited to 'src/fpm_backend_output.f90') diff --git a/src/fpm_backend_output.f90 b/src/fpm_backend_output.f90 index 82c019f..4eb2889 100644 --- a/src/fpm_backend_output.f90 +++ b/src/fpm_backend_output.f90 @@ -1,15 +1,38 @@ 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_targets, only: build_target_ptr use fpm_backend_console, only: console_t use M_attr, only: attr, attr_mode implicit none +type build_progress_t + + type(console_t) :: console + + integer :: n_complete + + integer :: n_target + + logical :: plain_mode = .true. + + integer, allocatable :: output_lines(:) + + type(build_target_ptr), pointer :: target_queue(:) + +contains + procedure :: init => output_init + procedure :: compiling_status => output_status_compiling + procedure :: completed_status => output_status_complete + procedure :: success => output_progress_success + +end type build_progress_t contains - subroutine output_init(plain_mode) + subroutine output_init(progress,target_queue,plain_mode) + class(build_progress_t), intent(out) :: progress + type(build_target_ptr), intent(in), target :: target_queue(:) logical, intent(in), optional :: plain_mode if (plain_mode) then @@ -18,80 +41,114 @@ contains call attr_mode('color') end if + call progress%console%init(plain_mode) + + progress%n_target = size(target_queue,1) + progress%target_queue => target_queue + progress%plain_mode = plain_mode + + allocate(progress%output_lines(progress%n_target)) + 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 + subroutine output_status_compiling(progress, queue_index) + class(build_progress_t), intent(inout) :: progress + integer, intent(in) :: queue_index character(:), allocatable :: target_name character(100) :: output_string + character(100) :: overall_progress - if (allocated(target%source)) then - target_name = basename(target%source%file_name) - else - target_name = basename(target%output_file) - end if + associate(target=>progress%target_queue(queue_index)%ptr) + + if (allocated(target%source)) then + target_name = basename(target%source%file_name) + else + target_name = basename(target%output_file) + end if + + write(overall_progress,'(A,I4,A)') '[',100*progress%n_complete/progress%n_target,'%]' + + if (progress%plain_mode) then + + !$omp critical + write(*,'(A8,A30)') trim(overall_progress),target_name + !$omp end critical - write(output_string,'(A,T40,A,A)') target_name,attr('compiling...') + else - line = console%write_line(trim(output_string)) + write(output_string,'(A,T40,A,A)') target_name,attr('compiling...') + call progress%console%write_line(trim(output_string),progress%output_lines(queue_index)) + + call progress%console%write_line(trim(overall_progress)//'Compiling...',advance=.false.) + + end if + + end associate 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 + + subroutine output_status_complete(progress, queue_index, build_stat) + class(build_progress_t), intent(inout) :: progress + integer, intent(in) :: queue_index 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('done.') - else - write(output_string,'(A,T40,A,A)') target_name,attr('failed.') - end if - - call console%update_line(line,trim(output_string)) + character(100) :: overall_progress !$omp critical - n_complete = n_complete + 1 + progress%n_complete = progress%n_complete + 1 !$omp end critical - end subroutine output_status_complete + associate(target=>progress%target_queue(queue_index)%ptr) - subroutine output_progress(n_complete, total, plain_mode) - integer, intent(in) :: n_complete, total - logical :: plain_mode + if (allocated(target%source)) then + target_name = basename(target%source%file_name) + else + target_name = basename(target%output_file) + end if - character(:), allocatable :: advance + if (build_stat == 0) then + write(output_string,'(A,T40,A,A)') target_name,attr('done.') + else + write(output_string,'(A,T40,A,A)') target_name,attr('failed.') + end if - if (plain_mode) then - advance = "yes" - else - advance = "no" - end if + write(overall_progress,'(A,I4,A)') '[',100*progress%n_complete/progress%n_target,'%] ' - !$omp critical - write(*,'(A,I4,A,A)',advance=advance) '[',100*n_complete/total,'%] Compiling project...' - !$omp end critical + if (progress%plain_mode) then + + !$omp critical + write(*,'(A8,A30,A7)') trim(overall_progress),target_name, 'done.' + !$omp end critical + + else - end subroutine output_progress + call progress%console%update_line(progress%output_lines(queue_index),trim(output_string)) - subroutine output_progress_complete() + call progress%console%write_line(trim(overall_progress)//'Compiling...',advance=.false.) - write(*,'(A)') char(27)//"[2K"//char(27)//"[1G"//attr('[100%] Project compiled successfully.') + end if + + end associate + + end subroutine output_status_complete + + subroutine output_progress_success(progress) + class(build_progress_t), intent(inout) :: progress + + if (progress%plain_mode) then + + write(*,'(A)') attr('[100%] Project compiled successfully.') + + else + + write(*,'(A)') progress%console%LINE_RESET//attr('[100%] Project compiled successfully.') + + end if - end subroutine output_progress_complete + end subroutine output_progress_success end module fpm_backend_output \ No newline at end of file -- cgit v1.2.3 From 93b629e504900432ea712cc3ed65dd937483e1c1 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sat, 27 Nov 2021 17:35:12 +0000 Subject: Add: developer documentation to new files --- src/fpm_backend_output.f90 | 58 ++++++++++++++++++++++++++++++++++------------ 1 file changed, 43 insertions(+), 15 deletions(-) (limited to 'src/fpm_backend_output.f90') diff --git a/src/fpm_backend_output.f90 b/src/fpm_backend_output.f90 index 4eb2889..8c7fd7d 100644 --- a/src/fpm_backend_output.f90 +++ b/src/fpm_backend_output.f90 @@ -1,3 +1,14 @@ +!># Build Backend Progress Output +!> This module provides a derived type `build_progress_t` for printing build status +!> and progress messages to the console while the backend is building the package. +!> +!> The `build_progress_t` type supports two modes: `normal` and `plain` +!> where the former does 'pretty' output and the latter does not. +!> The `normal` mode is intended for typical interactive usage whereas +!> 'plain' mode is used with the `--verbose` flag or when `stdout` is not attached +!> to a terminal (e.g. when piping or redirecting `stdout`). In these cases, +!> the pretty output must be suppressed to avoid control codes being output. + module fpm_backend_output use iso_fortran_env, only: stdout=>output_unit use fpm_filesystem, only: basename @@ -6,33 +17,43 @@ use fpm_backend_console, only: console_t use M_attr, only: attr, attr_mode implicit none -type build_progress_t +private +public build_progress_t +!> Build progress object +type build_progress_t + !> Console object for updating console lines type(console_t) :: console - + !> Number of completed targets integer :: n_complete - + !> Total number of targets scheduled integer :: n_target - + !> 'Plain' output (no colors or updating) logical :: plain_mode = .true. - + !> Store needed when updating previous console lines integer, allocatable :: output_lines(:) - + !> Queue of scheduled build targets type(build_target_ptr), pointer :: target_queue(:) - contains + !> Initialise build progress object procedure :: init => output_init + !> Output 'compiling' status for build target procedure :: compiling_status => output_status_compiling + !> Output 'complete' status for build target procedure :: completed_status => output_status_complete + !> Output finished status for whole package procedure :: success => output_progress_success - end type build_progress_t contains + !> Initialise build progress object subroutine output_init(progress,target_queue,plain_mode) + !> Progress object to initialise class(build_progress_t), intent(out) :: progress + !> The queue of scheduled targets type(build_target_ptr), intent(in), target :: target_queue(:) + !> Enable 'plain' output for progress object logical, intent(in), optional :: plain_mode if (plain_mode) then @@ -51,8 +72,11 @@ contains end subroutine output_init + !> Output 'compiling' status for build target and overall percentage progress subroutine output_status_compiling(progress, queue_index) + !> Progress object class(build_progress_t), intent(inout) :: progress + !> Index of build target in the target queue integer, intent(in) :: queue_index character(:), allocatable :: target_name @@ -69,13 +93,13 @@ contains write(overall_progress,'(A,I4,A)') '[',100*progress%n_complete/progress%n_target,'%]' - if (progress%plain_mode) then + if (progress%plain_mode) then ! Plain output !$omp critical write(*,'(A8,A30)') trim(overall_progress),target_name !$omp end critical - else + else ! Pretty output write(output_string,'(A,T40,A,A)') target_name,attr('compiling...') call progress%console%write_line(trim(output_string),progress%output_lines(queue_index)) @@ -88,10 +112,13 @@ contains end subroutine output_status_compiling - + !> Output 'complete' status for build target and update overall percentage progress subroutine output_status_complete(progress, queue_index, build_stat) + !> Progress object class(build_progress_t), intent(inout) :: progress + !> Index of build target in the target queue integer, intent(in) :: queue_index + !> Build status flag integer, intent(in) :: build_stat character(:), allocatable :: target_name @@ -118,13 +145,13 @@ contains write(overall_progress,'(A,I4,A)') '[',100*progress%n_complete/progress%n_target,'%] ' - if (progress%plain_mode) then + if (progress%plain_mode) then ! Plain output !$omp critical write(*,'(A8,A30,A7)') trim(overall_progress),target_name, 'done.' !$omp end critical - else + else ! Pretty output call progress%console%update_line(progress%output_lines(queue_index),trim(output_string)) @@ -136,14 +163,15 @@ contains end subroutine output_status_complete + !> Output finished status for whole package subroutine output_progress_success(progress) class(build_progress_t), intent(inout) :: progress - if (progress%plain_mode) then + if (progress%plain_mode) then ! Plain output write(*,'(A)') attr('[100%] Project compiled successfully.') - else + else ! Pretty output write(*,'(A)') progress%console%LINE_RESET//attr('[100%] Project compiled successfully.') -- cgit v1.2.3 From 6aba40db1385007e0bf4e9c2b9b4afe8bb105593 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 28 Nov 2021 11:24:41 +0000 Subject: Apply suggestion: don't use TBP for new constructors --- src/fpm_backend_output.f90 | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) (limited to 'src/fpm_backend_output.f90') diff --git a/src/fpm_backend_output.f90 b/src/fpm_backend_output.f90 index 8c7fd7d..2cc8597 100644 --- a/src/fpm_backend_output.f90 +++ b/src/fpm_backend_output.f90 @@ -35,8 +35,6 @@ type build_progress_t !> Queue of scheduled build targets type(build_target_ptr), pointer :: target_queue(:) contains - !> Initialise build progress object - procedure :: init => output_init !> Output 'compiling' status for build target procedure :: compiling_status => output_status_compiling !> Output 'complete' status for build target @@ -45,16 +43,21 @@ contains procedure :: success => output_progress_success end type build_progress_t +!> Constructor for build_progress_t +interface build_progress_t + procedure :: new_build_progress +end interface build_progress_t + contains - !> Initialise build progress object - subroutine output_init(progress,target_queue,plain_mode) - !> Progress object to initialise - class(build_progress_t), intent(out) :: progress + !> Initialise a new build progress object + function new_build_progress(target_queue,plain_mode) result(progress) !> The queue of scheduled targets type(build_target_ptr), intent(in), target :: target_queue(:) !> Enable 'plain' output for progress object logical, intent(in), optional :: plain_mode + !> Progress object to initialise + type(build_progress_t) :: progress if (plain_mode) then call attr_mode('plain') @@ -62,15 +65,16 @@ contains call attr_mode('color') end if - call progress%console%init(plain_mode) + progress%console = console_t(plain_mode) progress%n_target = size(target_queue,1) progress%target_queue => target_queue progress%plain_mode = plain_mode + progress%n_complete = 0 allocate(progress%output_lines(progress%n_target)) - end subroutine output_init + end function new_build_progress !> Output 'compiling' status for build target and overall percentage progress subroutine output_status_compiling(progress, queue_index) -- cgit v1.2.3 From b0115d1a000ee15d3ca773c3da3300595d805454 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 28 Nov 2021 11:43:49 +0000 Subject: Apply suggestion: don't use M_attr, simplify implementation --- src/fpm_backend_output.f90 | 22 +++++++--------------- 1 file changed, 7 insertions(+), 15 deletions(-) (limited to 'src/fpm_backend_output.f90') diff --git a/src/fpm_backend_output.f90 b/src/fpm_backend_output.f90 index 2cc8597..3f297f7 100644 --- a/src/fpm_backend_output.f90 +++ b/src/fpm_backend_output.f90 @@ -13,8 +13,7 @@ module fpm_backend_output use iso_fortran_env, only: stdout=>output_unit use fpm_filesystem, only: basename use fpm_targets, only: build_target_ptr -use fpm_backend_console, only: console_t -use M_attr, only: attr, attr_mode +use fpm_backend_console, only: console_t, LINE_RESET, COLOR_RED, COLOR_GREEN, COLOR_YELLOW, COLOR_RESET implicit none private @@ -58,14 +57,6 @@ contains logical, intent(in), optional :: plain_mode !> Progress object to initialise type(build_progress_t) :: progress - - if (plain_mode) then - call attr_mode('plain') - else - call attr_mode('color') - end if - - progress%console = console_t(plain_mode) progress%n_target = size(target_queue,1) progress%target_queue => target_queue @@ -105,7 +96,8 @@ contains else ! Pretty output - write(output_string,'(A,T40,A,A)') target_name,attr('compiling...') + write(output_string,'(A,T40,A,A)') target_name, COLOR_YELLOW//'compiling...'//COLOR_RESET + call progress%console%write_line(trim(output_string),progress%output_lines(queue_index)) call progress%console%write_line(trim(overall_progress)//'Compiling...',advance=.false.) @@ -142,9 +134,9 @@ contains end if if (build_stat == 0) then - write(output_string,'(A,T40,A,A)') target_name,attr('done.') + write(output_string,'(A,T40,A,A)') target_name,COLOR_GREEN//'done.'//COLOR_RESET else - write(output_string,'(A,T40,A,A)') target_name,attr('failed.') + write(output_string,'(A,T40,A,A)') target_name,COLOR_RED//'failed.'//COLOR_RESET end if write(overall_progress,'(A,I4,A)') '[',100*progress%n_complete/progress%n_target,'%] ' @@ -173,11 +165,11 @@ contains if (progress%plain_mode) then ! Plain output - write(*,'(A)') attr('[100%] Project compiled successfully.') + write(*,'(A)') '[100%] Project compiled successfully.' else ! Pretty output - write(*,'(A)') progress%console%LINE_RESET//attr('[100%] Project compiled successfully.') + write(*,'(A)') LINE_RESET//COLOR_GREEN//'[100%] Project compiled successfully.'//COLOR_RESET end if -- cgit v1.2.3