package easy_logging

  1. Overview
  2. Docs
Module to easily log messages

Install 

dune-project
 Dependency

sapristi.github.io Readme Edit opam file Versions (11)

Authors

  1. M
    Mathias Millet

Maintainers

  1. M
    mathiasmillet@gmail.com

Sources

v0.4
md5=dea0798a0e16c4c3adcd66284c78f02e
sha512=cec0646fac2c3ef0bca8991053fb0f8867737b6809cb0b191fb806d69df50ddd42fac8dc3147fb5c7f070a8156188fd7f168699189c10a3cbd3d880f81da0fbf

doc/src/easy_logging/easy_logging.ml.html

Source file easy_logging.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126


(* Type for log levels *)
type log_level = Easy_logging_types.level
let show_log_level = Easy_logging_types.show_level
let pp_log_level fmt lvl = Format.pp_print_string fmt (show_log_level lvl)

module type HandlersT = Easy_logging_types.HandlersT
                     
                      
module MakeLogging (H : HandlersT) =
  struct

  
    class logger
            ?parent:(parent=None)
            (name: string)
      =
    object(self)
             
      val name = name
      val mutable level : log_level option = None              
      val mutable handlers : H.t list = []
      val parent : logger option = parent
      val mutable propagate = true

      method set_level new_level =
        level <- Some new_level
      method add_handler h = handlers <- h::handlers
      method set_propagate p = propagate <- p
           
      method effective_level : log_level =
        match level, parent  with
        | None, None  -> NoLevel
        | None, Some p -> p#effective_level
        | Some l,_ -> l
                          
      method get_handlers =
        match propagate, parent with
        | true, Some p -> handlers @ p#get_handlers
        | _ -> handlers

      method private treat_msg : 'a. ('a -> string) -> H.tag list -> log_level -> 'a -> unit
        = fun unwrap_fun tags msg_level msg ->
        
        let item : H.log_item= {
            level = msg_level;
            logger_name = name;
            msg = unwrap_fun msg;
            tags=tags} in 
        List.iter (fun handler ->
            H.apply handler item)
          self#get_handlers
        
      method private _log_msg : 'a. ('a -> string) -> H.tag list -> log_level -> 'a -> unit
        = fun unwrap_fun tags msg_level msg ->
           if msg_level >= self#effective_level
           then
             self#treat_msg unwrap_fun tags msg_level msg
           else
             ()                           
          
      method private _flog_msg : 'a. H.tag list -> log_level -> ('a, unit, string, unit) format4 -> 'a
        =  fun tags msg_level -> 
        if msg_level >= self#effective_level
        then
          Printf.ksprintf (
              self#treat_msg (fun x -> x) tags msg_level)
        else Printf.ifprintf () 
        

      method flash : 'a. ?tags:H.tag list -> ('a, unit, string, unit) format4 -> 'a
        = fun ?tags:(tags=[]) -> self#_flog_msg tags Flash
      method error : 'a. ?tags:H.tag list -> ('a, unit, string, unit) format4 -> 'a
        = fun ?tags:(tags=[]) -> self#_flog_msg tags Error
      method warning : 'a. ?tags:H.tag list -> ('a, unit, string, unit) format4 -> 'a
        = fun ?tags:(tags=[]) -> self#_flog_msg tags Warning
      method info : 'a. ?tags:H.tag list -> ('a, unit, string, unit) format4 -> 'a
        = fun ?tags:(tags=[]) -> self#_flog_msg tags Info        
      method debug : 'a. ?tags:H.tag list -> ('a, unit, string, unit) format4 -> 'a
        = fun ?tags:(tags=[]) -> self#_flog_msg tags Debug

                               
      method sflash ?tags:(tags=[]) = self#_log_msg (fun x->x) tags Flash
      method serror ?tags:(tags=[]) = self#_log_msg (fun x->x) tags Error
      method swarning ?tags:(tags=[]) = self#_log_msg (fun x->x) tags Warning
      method sinfo ?tags:(tags=[]) =  self#_log_msg (fun x->x) tags Info
      method sdebug ?tags:(tags=[]) = self#_log_msg (fun x->x) tags Debug

                                    
      method lflash ?tags:(tags=[]) = self#_log_msg Lazy.force tags Flash
      method lerror ?tags:(tags=[]) = self#_log_msg Lazy.force tags Error
      method lwarning ?tags:(tags=[]) = self#_log_msg Lazy.force tags Warning
      method linfo ?tags:(tags=[]) =  self#_log_msg Lazy.force tags Info
      method ldebug ?tags:(tags=[]) = self#_log_msg Lazy.force tags Debug
    end

    let root_logger = new logger "root"
      
    module Infra =
      Logging_infra.MakeTree(
          struct
            type t = logger
            let make (n:string) parent = new logger ~parent n
            let root = root_logger
          end)
                        
      
    let get_logger name =
      Infra.get name
        
    let make_logger ?propagate:(propagate=true) name lvl hdescs  =
      let l = Infra.get name in
      l#set_level lvl;
      l#set_propagate propagate;
      List.iter (fun hdesc -> l#add_handler (H.make hdesc)) hdescs;
      l

 
   end

module Default_handlers = Default_handlers
                
module Logging = MakeLogging(Default_handlers)