1:- module(log4p,[
    2  fatal/1,
    3  error/1,
    4  warn/1,
    5  info/1,
    6  debug/1,
    7  trace/1,
    8
    9  fatal/2,
   10  error/2,
   11  warn/2,
   12  info/2,
   13  debug/2,
   14  trace/2,
   15
   16  get_log_level/1,
   17
   18  set_global_log_level/1,
   19  set_global_log_level/2,
   20  clear_global_log_level/0,
   21
   22  set_local_log_level/1,
   23  set_local_log_level/2,
   24  clear_local_log_level/0,
   25
   26  log_levels/1,
   27
   28  add_log_handler/1,
   29  remove_log_handler/1,
   30  stderr_log_handler/2,
   31
   32  use_default_log_handler/0,
   33  use_stderr_log_handler/0,
   34
   35  logf/3,
   36  log/2
   37  ]).   38
   39fatal(Message) :- logf(fatal,Message,[]).
   40error(Message) :- logf(error,Message,[]).
   41warn(Message) :- logf(warn,Message,[]).
   42info(Message) :- logf(info,Message,[]).
   43debug(Message) :- logf(debug,Message,[]).
   44trace(Message) :- logf(trace,Message,[]).
   45
   46
   47fatal(Message,Arguments) :- logf(fatal,Message,Arguments).
   48error(Message,Arguments) :- logf(error,Message,Arguments).
   49warn(Message,Arguments) :- logf(warn,Message,Arguments).
   50info(Message,Arguments) :- logf(info,Message,Arguments).
   51debug(Message,Arguments) :- logf(debug,Message,Arguments).
   52trace(Message,Arguments) :- logf(trace,Message,Arguments).
   53
   54use_default_log_handler :-
   55  retractall(log_handler(_)),
   56  add_log_handler(default_log_handler).
   57
   58
   59use_stderr_log_handler :-
   60  retractall(log_handler(_)),
   61  add_log_handler(stderr_log_handler).
   62
   63:- dynamic log_handler/1.   64:- thread_local log_handler/1.   65
   66log_handler(default_log_handler).
   67
   68add_log_handler(NewHandler) :-
   69  Clause = log_handler(NewHandler),
   70  Clause ; assertz(log_handler(NewHandler)).
   71
   72remove_log_handler(OldHandler) :-
   73  retractall(log_handler(OldHandler)).
   74
   75default_log_handler(Level,Message) :-
   76  writef('%w: %w\n',[Level, Message]),
   77  flush_output.
   78
   79stderr_log_handler(Level,Message) :-
   80  with_output_to(user_error, (
   81    default_log_handler(Level, Message)
   82    )
   83  ).
   84
   85:- dynamic global_log_level/1.   86
   87:- thread_local local_log_level/1.   88
   89% Defines the default log level, if no other value
   90% has been set
   91default_log_level(info).
   92
   93% Return the current effective log level,
   94% choosing any locally set log level first,
   95% then the global log level, and finally the 
   96% default (info)
   97get_log_level(LogLevel) :-
   98  local_log_level(LogLevel), !.
   99
  100get_log_level(LogLevel) :-
  101  global_log_level(LogLevel), !.
  102
  103get_log_level(LogLevel) :-
  104  default_log_level(LogLevel),!.
  105
  106set_global_log_level(NewLevel) :-
  107  set_global_log_level(NewLevel, _).
  108
  109set_global_log_level(NewLevel,_) :-
  110  var(NewLevel), !.
  111
  112set_global_log_level(NewLevel,OldLevel) :-
  113  ( global_log_level(OldLevel)
  114    -> clear_global_log_level
  115    ; true
  116    ),
  117  asserta(global_log_level(NewLevel)).
  118
  119clear_global_log_level :-
  120  retractall(global_log_level(_)).
  121
  122set_local_log_level(NewLevel) :-
  123  set_local_log_level(NewLevel, _).
  124
  125set_local_log_level(NewLevel, _) :-
  126  % we don't set a variable as the current log level
  127  var(NewLevel), !.
  128
  129set_local_log_level(NewLevel,OldLevel) :-
  130  ( local_log_level(OldLevel)
  131    -> clear_local_log_level
  132    ; true
  133    ),
  134  retractall(local_log_level(OldLevel)),
  135  asserta(local_log_level(NewLevel)).
  136
  137clear_local_log_level :-
  138  retractall(local_log_level(_)).
  139
  140log_levels([trace,debug,info,warn,error,fatal]).
  141
  142valid_log_levels(ValidLevels) :-
  143  get_log_level(Level),
  144  log_levels(Levels),
  145  valid_log_levels(Level,Levels,ValidLevels).
  146
  147valid_log_levels(LogLevel,[LogLevel | Rest],[LogLevel | Rest]).
  148
  149valid_log_levels(LogLevel,[_Head|Rest],ValidLevels) :-
  150  valid_log_levels(LogLevel,Rest,ValidLevels).
  151
  152logf(Level,Message,Arguments) :-
  153  swritef(FullMessage,Message,Arguments),
  154  log(Level,FullMessage).
  155
  156% We don't log if the level is not valid
  157log(Level,_Message) :-
  158  log_levels(Levels),
  159  \+member(Level,Levels),
  160  !.
  161
  162% We also don't log if the level is too low (e.g, below current)
  163log(Level,_Message) :-
  164  log_levels(Levels),
  165  get_log_level(Current),
  166  index_of(Level,Levels,LevelIndex),
  167  index_of(Current,Levels,CurrentIndex),
  168  LevelIndex < CurrentIndex,
  169  !.
  170
  171log(Level,Message) :-
  172  forall(log_handler(Handler),apply(Handler,[Level,Message])).
  173
  174index_of(Element,List,Index) :-
  175  index_of(0,Element,List,Index).
  176
  177index_of(Current,Element,[Element|_],Current) :- !.
  178
  179index_of(Current, Element, [_|RestOfList], Index) :- 
  180  Next is Current + 1,
  181  index_of(Next, Element, RestOfList,Index)