! 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