(*---------------------------------------------------------------------------*
  INTERFACE  cf_journal.mli

  Copyright (c) 2004-2006, James H. Woodyatt
  All rights reserved.

  Redistribution and use in source and binary forms, with or without
  modification, are permitted provided that the following conditions
  are met:

    Redistributions of source code must retain the above copyright
    notice, this list of conditions and the following disclaimer.

    Redistributions in binary form must reproduce the above copyright
    notice, this list of conditions and the following disclaimer in
    the documentation and/or other materials provided with the
    distribution

  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
  INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
  OF THE POSSIBILITY OF SUCH DAMAGE. 
 *---------------------------------------------------------------------------*)

(** Diagnostic event journaling. *)

(** {6 Overview} *)

(** This module implements a lightweight foundation for diagnostic event
    journaling, similar to the core Java classes in the {b Log4j} project from
    the Apache Foundation.
    
    The core interface is functorial, and is intended for extensibility.  An
    additional interface is provided for simplicity of use in the common case
    of journaling diagnostic messages to [Pervasives.out_channel] objects, e.g
    [stdout] and [stderr].
*)

(** {6 Functorial Interface} *)

(** The type of the module produced the [Create(P: Cf_ordered.Total_T)]
    functor defined below.
*)

module type T = sig

    (** The module used to define the total order of priority levels. *)
    module Priority: Cf_ordered.Total_T
    
    (** The base class for prioritizers.  Defines methods for converting
        priority levels into 1) their corresponding code, and 2) their
        corresponding message tag.
    *)
    class virtual ['level] prioritizer:
        object
            (** Use [p#code v] to convert the priority level [v] to a priority
                code with the prioritizer [p].
            *)
            method virtual code: 'level -> Priority.t

            (** Use [p#tag v] to convert the priority level [v] to a message
                tag with the prioritizer [p].
            *)
            method virtual tag: 'level -> string
        end

    (** The minimal class of diagnostic events.  Use [new event p v m] to
        construct an [event] object with the prioritizer [p], the priority
        level [v], and the message [m].
    *)
    class ['level] event:
        'level #prioritizer -> 'level -> string ->
        object
        
            (** Returns the prioritizer used to construct the object. *)
            method prioritizer: 'level prioritizer
        
            (** Returns the priority level used to construct the object. *)
            method level: 'level
        
            (** Returns the message text used to construct the object. *)
            method message: string
        end
    
    (** The base class for event archivers.  Use [inherit archiver] to derive
        a subclass that defines the [emit] method to archive a diagnostic
        event into a journaling system.
    *)
    class virtual ['event] archiver:
        object
            constraint 'event = 'level #event
            
            (** Define the [emit] method in a subclass to archive diagnostic
                events into a journaling system.
            *)
            method virtual emit: 'event -> unit
        end

    (** The base class for journaling agents.  Use [inherit agent p v s] to
        derive a subclass that defines the private [event_] method to construct
        an event object with a priority level and a message text using the
        prioritizer [p].  Sets the initial priority code minimum to [v], and
        the initial list of archivers to [s].
    *)
    class virtual ['archiver] agent:
        'level #prioritizer -> 'level -> 'archiver list ->
        object
            constraint 'event = 'level #event
            constraint 'archiver = 'event #archiver

            (** The current list of archivers that journal events from
                this agent. *)
            val mutable archivers_: 'archiver list
            
            (** The minimum priority code for a diagnostic event to be
                constructed and passed to the archivers.
            *)
            val mutable limit_: Priority.t            

            (** Define the private [event] method to construct an event object
                with a priority level and a message text.
            *)
            method private virtual event: 'level -> string -> 'event

            (** Use [a#setlimit v] to set the minimum priority code to the
                code corresponding to the priority level [v].
            *)
            method setlimit: 'level -> unit
            
            (** Use [a#enabled v] to test whether the priority code
                corresponding to the priority level [v] is preceded in the
                total order by the minimum priority code.
            *)
            method enabled: 'level -> bool
            
            (** Use this method in level-specific methods of the derived class
                for constructing events and putting them to archivers.  Use
                [super#put v c] to construct a function that takes a format
                string (and arguments thereby specified) and, if [self#enabled
                v] returns [true] then calls [self#event v m] (where [m] is
                the message text given to the continuation provided to
                [Printf.kprintf]), iterates on [archivers_] invoking the
                [emit] method for each one with the constructed event, and
                finally passing the event to the continuation [c].  The value
                returned by [c] is returned by the method when invoked with
                a format string (and associated arguments).
            *)
            method private put:
                'a 'b. 'level -> ('event -> 'b) ->
                ('a, unit, string, 'b) format4 -> 'a
        end
end

(** A functor that produces a module of type [T] that defines extensible
    diagnostic event journaling with messages prioritized by codes in the total
    order defined by the module [P].
*)
module Create(P: Cf_ordered.Total_T): T with module Priority = P

(** {6 Basic Interface} *)

(** A module defining basic diagnostic event journaling with a simple set of
    priority levels associated to integer priority codes.
*)
module Basic: sig
    
    (** Event journaling with integer priority codes. *)
    include T with type Priority.t = int

    (** The priority level for events indicating that an internal program
        function has been called with invalid arguments.  Code=7000.
    *)
    type invalid = [ `Invalid ]

    (** The priority level for events indicating that an internal program
        function has failed, results may have been lost and recovery is not
        expected.  Code=6000.
    *)
    type fail = [ `Fail ]

    (** The priority level for events indicating that a program has encountered
        invalid input.  The program is expected to recover and continue
        processing further valid input correctly.  Code=5000.
    *)
    type error = [ `Error ]

    (** The priority level for events indicating that a program has encountered
        unexpected input, indicating that an external process may have failed.
        The program is expected to continue processing further input normally.
        Code=4000.
    *)
    type warn = [ `Warn ]

    (** The priority level for events indicating exceptional information about
        the processing of the program useful for diagnosing external processes.
        Code=2000.
    *)
    type notice = [ `Notice ]

    (** The priority level for events indicating normal information about the
        processing of the program useful for diagnosing external processes.
        Code=2000.
    *)
    type info = [ `Info ]

    (** The priority level for events describing internal processing of the
        program for the purpose of diagnosing programming errors.  Code=1000.
    *)
    type debug = [ `Debug ]
    
    (** The priority levels corresponding to events that the basic agent has
        public methods for journaling.
    *)
    type basic = [ invalid | fail | error | warn | notice | info | debug ]
    
    (** Additional priority levels corresponding to limit levels in the basic
        event prioritizer used for completely enabling or disabling all
        messages.  These levels do not have message tags defined.
    *)
    type enable = [ `None | `All ]
    
    (** The sum of all basic priority levels. *)
    type level = [ basic | enable ]
end

(** The basic prioritizer class, defining the priority codes and message tags
    for all of the basic priority levels: [`Invalid], [`Fail], [`Error],
    [`Warn], [`Info] and [`Debug].  Derive a subclass to define a prioritizer
    for additional priority levels corresponding to other integer codes.
*)
class ['level] basic_prioritizer :
    object
        constraint 'level = [> Basic.level ]

        (** Returns the integer corresponding to the priority level. *)
        method code: 'level -> Basic.Priority.t
        
        (** Returns the message tag corresponding to the priority level. *)
        method tag: 'level -> string
    end

(** The basic channel archiver.  Use [new basic_channel_archiver c] to
    construct an archiver that emits each basic event [e] with a priority level
    less than [`Fail] to the channel [c] using [Printf.fprintf c "%s: %s\n"
    e#prioritizer#tag e#message].
*)
class ['event] basic_channel_archiver:
    out_channel ->
    object
        constraint 'event = [> Basic.level ] #Basic.event

        (** Returns the channel used to construct the archiver. *)
        method channel: out_channel
        
        (** Emits each basic event [e] with a priority level less than [`Fail]
            to the channel [c] using [Printf.fprintf c "%s: %s\n"
            e#prioritizer#tag e#message].
        *)
        method emit: 'event -> unit
    end

(** The basic journaling agent.  Derive a subclass to define an agent that can
    construct events derived from the basic event (which may also require
    archivers derived from the basic archiver that can format any additional
    required output).  The class defines six public methods for output of
    diagnostic events, one for each basic priority level.
*)
class virtual ['archiver] basic_agent:
    'level #basic_prioritizer -> 'level -> 'archiver list ->
    object
        constraint 'level = [> Basic.level ]
        constraint 'event = 'level #Basic.event
        constraint 'archiver = 'event #Basic.archiver
        inherit ['archiver] Basic.agent

        (** Use [a#invalid msg ...] to format message text to put to the
            archivers at the [`Invalid] level, and finally used to raise an
            [Invalid_argument] exception.
        *)
        method invalid: 'a 'b. ('a, unit, string, 'b) format4 -> 'a

        (** Use [a#fail msg ...] to format message text to put to the
            archivers at the [`Fail] level, and finally used to raise an
            [Failure] exception.
        *)
        method fail: 'a 'b. ('a, unit, string, 'b) format4 -> 'a

        (** Use [a#error msg ...] to format message text to put to the
            archivers at the [`Error] level.
        *)
        method error: 'a. ('a, unit, string, unit) format4 -> 'a

        (** Use [a#warn msg ...] to format message text to put to the
            archivers at the [`Warn] level.
        *)
        method warn: 'a. ('a, unit, string, unit) format4 -> 'a

        (** Use [a#notice msg ...] to format message text to put to the
            archivers at the [`Notice] level.
        *)
        method notice: 'a. ('a, unit, string, unit) format4 -> 'a

        (** Use [a#info msg ...] to format message text to put to the
            archivers at the [`Info] level.
        *)
        method info: 'a. ('a, unit, string, unit) format4 -> 'a

        (** Use [a#debug msg ...] to format message text to put to the
            archivers at the [`Debug] level.  The result of the formatting
            continuation is always [true].  This is to facilitate using the
            method inside [assert] blocks.
        *)
        method debug: 'a. ('a, unit, string, bool) format4 -> 'a
    end

(** The type of the most basic agent, used for [stdout] and [stderr] below. *)
type t = Basic.level Basic.event Basic.archiver basic_agent

(** A basic agent, initially set with a limit of [`Notice], and with with one
    basic archiver for the [Pervasives.stdout] channel.
*)
val stdout: t

(** A basic agent, initially set with a limit of [`Notice], and with with one
    basic archiver for the [Pervasives.stderr] channel.
*)
val stderr: t

(*--- End of File [ cf_journal.mli ] ---*)