208 lines
6.0 KiB
Fortran
208 lines
6.0 KiB
Fortran
! This module provides a minimal logging framework
|
|
!
|
|
! There are 4 logging levels, controlled via `set_log_level`, of increasing
|
|
! verbosity. If the logging level is lower than the level of a message,
|
|
! it will be discarded, otherwise it will be written to the standard error.
|
|
!
|
|
! Messages are emitted using `log_message(msg, level, mod, proc)` or one
|
|
! of the specialised subroutine (`log_error`, `log_warning`, etc.).
|
|
!
|
|
! The format of the log is: [time] [module:procedure] [level] <message>
|
|
module logger
|
|
|
|
use, intrinsic :: iso_fortran_env, only : error_unit
|
|
#ifdef INTEL
|
|
use ifport, only : isatty
|
|
#endif
|
|
|
|
implicit none
|
|
|
|
! Log levels
|
|
enum, bind(C)
|
|
enumerator :: log_level = -1
|
|
enumerator :: ERROR = 0 ! errors, critical
|
|
enumerator :: WARNING = 1 ! warnings, non-critical
|
|
enumerator :: INFO = 2 ! user informational messages
|
|
enumerator :: DEBUG = 3 ! debugging messages
|
|
end enum
|
|
|
|
! ANSI escape sequences for colors
|
|
type ansi_colors
|
|
character(8) :: red, green, yellow, white, blue, reset
|
|
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_unit = error_unit
|
|
type(ansi_colors), save :: colorscheme = base16
|
|
|
|
private
|
|
public log_message, set_logger
|
|
public log_error, log_warning, log_info, log_debug
|
|
public log_level, ERROR, WARNING, INFO, DEBUG
|
|
|
|
contains
|
|
|
|
subroutine log_message(msg, level, mod, proc)
|
|
! Logs a message to the standard error where:
|
|
! msg: message to log
|
|
! level: log level of the message
|
|
! mod: module emitting the message
|
|
! proc: procedure emitting the message
|
|
|
|
! subroutine argument
|
|
character(*), intent(in) :: msg
|
|
integer(kind(log_level)), intent(in) :: level
|
|
character(*), intent(in) :: mod
|
|
character(*), intent(in), optional :: proc
|
|
|
|
! local variables
|
|
character(512) :: id, kind, time
|
|
real :: now
|
|
|
|
if (level > current_level) return
|
|
|
|
! execution time in μs (eg. [0571258])
|
|
call cpu_time(now)
|
|
write (time, '("[",i0.7,"]")') int(now * 1e6)
|
|
time = trim(colorscheme%blue) // trim(time) // trim(colorscheme%reset)
|
|
|
|
! id of the emitter (eg. [program:main])
|
|
id = mod
|
|
if (present(proc)) id = trim(id) // ':' // trim(proc)
|
|
|
|
! kind of message (eg. [warning])
|
|
kind = trim(level_color(level)) // &
|
|
trim(level_name(level)) // &
|
|
trim(colorscheme%reset)
|
|
|
|
write (current_unit, '(a, 2(x,"[",a,"]"), x,a)') &
|
|
trim(time), trim(id), trim(kind), trim(msg)
|
|
|
|
end subroutine log_message
|
|
|
|
|
|
! Specialised log_message variants
|
|
|
|
subroutine log_error(msg, mod, proc)
|
|
! Logs an error
|
|
character(*), intent(in) :: msg
|
|
character(*), intent(in) :: mod
|
|
character(*), intent(in), optional :: proc
|
|
call log_message(msg, ERROR, mod, proc)
|
|
end subroutine log_error
|
|
|
|
subroutine log_warning(msg, mod, proc)
|
|
! Logs a warning
|
|
character(*), intent(in) :: msg
|
|
character(*), intent(in) :: mod
|
|
character(*), intent(in), optional :: proc
|
|
call log_message(msg, WARNING, mod, proc)
|
|
end subroutine log_warning
|
|
|
|
subroutine log_info(msg, mod, proc)
|
|
! Logs an informational message
|
|
character(*), intent(in) :: msg
|
|
character(*), intent(in) :: mod
|
|
character(*), intent(in), optional :: proc
|
|
call log_message(msg, INFO, mod, proc)
|
|
end subroutine log_info
|
|
|
|
subroutine log_debug(msg, mod, proc)
|
|
! Logs a debugging message
|
|
character(*), intent(in) :: msg
|
|
character(*), intent(in) :: mod
|
|
character(*), intent(in), optional :: proc
|
|
call log_message(msg, DEBUG, mod, proc)
|
|
end subroutine log_debug
|
|
|
|
|
|
subroutine set_logger(level, unit, colored)
|
|
! Set the current logging level, log file unit
|
|
! and whether to use colored output.
|
|
!
|
|
! Only messages with a lower level than the current
|
|
! 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
|
|
integer(kind(log_level)), intent(in), optional :: level
|
|
integer, intent(in), optional :: unit
|
|
logical, intent(in), optional :: colored
|
|
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
|
|
msg = 'changed level to ' // trim(level_name(level))
|
|
call log_debug(msg, mod='logger', proc='set_log_level')
|
|
end if
|
|
|
|
end subroutine set_logger
|
|
|
|
|
|
pure function level_color(level) result(escape)
|
|
! The color associated to a log level
|
|
|
|
! function arguments
|
|
integer(kind(log_level)), intent(in) :: level
|
|
character(8) :: escape
|
|
|
|
select case (level)
|
|
case (ERROR)
|
|
escape = colorscheme%red
|
|
case (WARNING)
|
|
escape = colorscheme%yellow
|
|
case (INFO)
|
|
escape = colorscheme%green
|
|
case (DEBUG)
|
|
escape = colorscheme%white
|
|
end select
|
|
|
|
end function level_color
|
|
|
|
|
|
pure function level_name(level) result(name)
|
|
! The human readable name of a log level
|
|
|
|
! function arguments
|
|
integer(kind(log_level)), intent(in) :: level
|
|
character(7) :: name
|
|
|
|
select case (level)
|
|
case (ERROR)
|
|
name = "error"
|
|
case (WARNING)
|
|
name = "warning"
|
|
case (INFO)
|
|
name = "info"
|
|
case (DEBUG)
|
|
name = "debug"
|
|
end select
|
|
|
|
end function level_name
|
|
|
|
end module logger
|