src/logger.f90: init

This change adds a minimal logging system. The log messages carry a
timestamp in μs, the identifier of the emitter (fortran module +
procedure) and a log level. For simplicity the format is hardcoded.

src/logger.f90

@@ -0,0 +1,188 @@
+! 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
+
+  ! 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    = achar(27) // '[1;31m'
+    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
+
+  integer(kind(log_level)), save :: current_level = WARNING
+  type(ansi_colors), parameter   :: colors = ansi_colors()
+
+  private
+  public log_message, set_log_level
+  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
+
+    use, intrinsic :: iso_fortran_env, only : error_unit
+
+    implicit none
+
+    ! 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(colors%blue) // trim(time) // trim(colors%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(colors%reset)
+
+    write (error_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
+    implicit none
+    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
+    implicit none
+    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
+    implicit none
+    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
+    implicit none
+    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_log_level(level)
+    ! Set the current logging level
+    !
+    ! Only messages with a lower level than the current
+    ! one will be actually logged.
+
+    implicit none
+
+    ! subroutine arguments
+    integer(kind(log_level)), intent(in) :: level
+    character(25) :: msg
+
+    current_level = level
+    msg = 'changed level to ' // trim(level_name(level))
+    call log_debug(msg, mod='logger', proc='set_log_level')
+
+  end subroutine set_log_level
+
+
+  pure function level_color(level) result(escape)
+    ! The color associated to a log level
+
+    implicit none
+
+    ! function arguments
+    integer(kind(log_level)), intent(in)  :: level
+    character(8)                          :: escape
+
+    select case (level)
+      case (ERROR)
+        escape = colors%red
+      case (WARNING)
+        escape = colors%yellow
+      case (INFO)
+        escape = colors%green
+      case (DEBUG)
+        escape = colors%white
+    end select
+
+  end function level_color
+
+
+  pure function level_name(level) result(name)
+    ! The human readable name of a log level
+
+    implicit none
+
+    ! 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