! 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