src/logger.f90: allow changing output unit and colors

This commit is contained in:
Michele Guerini Rocco 2024-09-11 17:17:37 +02:00 committed by rnhmjoj
parent 52693be83e
commit 918d239b34
Signed by: rnhmjoj
GPG Key ID: BFBAF4C975F76450
2 changed files with 52 additions and 26 deletions

View File

@ -10,6 +10,8 @@
! The format of the log is: [time] [module:procedure] [level] <message> ! The format of the log is: [time] [module:procedure] [level] <message>
module logger module logger
use, intrinsic :: iso_fortran_env, only : error_unit
implicit none implicit none
! Log levels ! Log levels
@ -23,19 +25,27 @@ module logger
! ANSI escape sequences for colors ! ANSI escape sequences for colors
type ansi_colors type ansi_colors
character(8) :: red = achar(27) // '[1;31m' character(8) :: red, green, yellow, white, blue, reset
character(8) :: green = achar(27) // '[0;32m'
character(8) :: yellow = achar(27) // '[1;33m'
character(8) :: white = achar(27) // '[1;39m'
character(8) :: blue = achar(27) // '[0;34m'
character(8) :: reset = achar(27) // '[0m'
end type end type
type(ansi_colors), parameter :: monochrome = &
ansi_colors(red='', green='', yellow='', white='', blue='', reset='')
type(ansi_colors), parameter :: base16 = &
ansi_colors(red = achar(27) // '[1;31m', &
green = achar(27) // '[0;32m', &
yellow = achar(27) // '[1;33m', &
white = achar(27) // '[1;39m', &
blue = achar(27) // '[0;34m', &
reset = achar(27) // '[0m')
! Logger state
integer(kind(log_level)), save :: current_level = WARNING integer(kind(log_level)), save :: current_level = WARNING
type(ansi_colors), parameter :: colors = ansi_colors() integer(kind(log_level)), save :: current_unit = error_unit
type(ansi_colors), save :: colorscheme = base16
private private
public log_message, set_log_level public log_message, set_logger
public log_error, log_warning, log_info, log_debug public log_error, log_warning, log_info, log_debug
public log_level, ERROR, WARNING, INFO, DEBUG public log_level, ERROR, WARNING, INFO, DEBUG
@ -48,8 +58,6 @@ contains
! mod: module emitting the message ! mod: module emitting the message
! proc: procedure emitting the message ! proc: procedure emitting the message
use, intrinsic :: iso_fortran_env, only : error_unit
! subroutine argument ! subroutine argument
character(*), intent(in) :: msg character(*), intent(in) :: msg
integer(kind(log_level)), intent(in) :: level integer(kind(log_level)), intent(in) :: level
@ -65,7 +73,7 @@ contains
! execution time in μs (eg. [0571258]) ! execution time in μs (eg. [0571258])
call cpu_time(now) call cpu_time(now)
write (time, '("[",i0.7,"]")') int(now * 1e6) write (time, '("[",i0.7,"]")') int(now * 1e6)
time = trim(colors%blue) // trim(time) // trim(colors%reset) time = trim(colorscheme%blue) // trim(time) // trim(colorscheme%reset)
! id of the emitter (eg. [program:main]) ! id of the emitter (eg. [program:main])
id = mod id = mod
@ -74,9 +82,9 @@ contains
! kind of message (eg. [warning]) ! kind of message (eg. [warning])
kind = trim(level_color(level)) // & kind = trim(level_color(level)) // &
trim(level_name(level)) // & trim(level_name(level)) // &
trim(colors%reset) trim(colorscheme%reset)
write (error_unit, '(a, 2(x,"[",a,"]"), x,a)') & write (current_unit, '(a, 2(x,"[",a,"]"), x,a)') &
trim(time), trim(id), trim(kind), trim(msg) trim(time), trim(id), trim(kind), trim(msg)
end subroutine log_message end subroutine log_message
@ -117,21 +125,39 @@ contains
end subroutine log_debug end subroutine log_debug
subroutine set_log_level(level) subroutine set_logger(level, unit, colored)
! Set the current logging level ! Set the current logging level, log file unit
! and whether to use colored output.
! !
! Only messages with a lower level than the current ! Only messages with a lower level than the current
! one will be actually logged. ! one will be actually logged.
!
! The logger defaults are warning level, output to stderr
! and colors only if the output unit is a terminal.
! subroutine arguments ! subroutine arguments
integer(kind(log_level)), intent(in) :: level integer(kind(log_level)), intent(in), optional :: level
integer, intent(in), optional :: unit
logical, intent(in), optional :: colored
character(25) :: msg character(25) :: msg
if (present(unit)) then
current_unit = unit
end if
if (present(colored)) then
colorscheme = base16
else
colorscheme = merge(base16, monochrome, isatty(current_unit))
end if
if (present(level)) then
current_level = level current_level = level
msg = 'changed level to ' // trim(level_name(level)) msg = 'changed level to ' // trim(level_name(level))
call log_debug(msg, mod='logger', proc='set_log_level') call log_debug(msg, mod='logger', proc='set_log_level')
end if
end subroutine set_log_level end subroutine set_logger
pure function level_color(level) result(escape) pure function level_color(level) result(escape)
@ -143,13 +169,13 @@ contains
select case (level) select case (level)
case (ERROR) case (ERROR)
escape = colors%red escape = colorscheme%red
case (WARNING) case (WARNING)
escape = colors%yellow escape = colorscheme%yellow
case (INFO) case (INFO)
escape = colors%green escape = colorscheme%green
case (DEBUG) case (DEBUG)
escape = colors%white escape = colorscheme%white
end select end select
end function level_color end function level_color

View File

@ -1,6 +1,6 @@
program main program main
use const_and_precisions, only : wp_ use const_and_precisions, only : wp_
use logger, only : INFO, ERROR, WARNING, set_log_level, log_message use logger, only : INFO, ERROR, WARNING, set_logger, log_message
use utils, only : dirname use utils, only : dirname
use types, only : contour use types, only : contour
use gray_cli, only : cli_options, parse_cli_options, & use gray_cli, only : cli_options, parse_cli_options, &
@ -35,7 +35,7 @@ program main
! Initialise logging ! Initialise logging
if (opts%quiet) opts%verbose = ERROR if (opts%quiet) opts%verbose = ERROR
call set_log_level(opts%verbose) call set_logger(level=opts%verbose)
! Load the parameters from file and move to its directory ! Load the parameters from file and move to its directory
! (all other filepaths are assumed relative to it) ! (all other filepaths are assumed relative to it)