Source file layout.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
(*
 * This file is part of Bolt.
 * Copyright (C) 2009-2012 Xavier Clerc.
 *
 * Bolt is free software; you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published by
 * the Free Software Foundation; either version 3 of the License, or
 * (at your option) any later version.
 *
 * Bolt is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public License
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
 *)


(* Definitions *)

type t = (string list) * (string list) * (Event.t -> string)

let _, register, register_unnamed, get =
  Utils.make_container_functions ()


(* Predefined layouts *)

let minimal =
  [], [], Event.render "$(message)"

let simple =
  [], [], Event.render "$(level:5) - $(message)"

let default =
  [], [], Event.render "$(relative:-8) [$(file:-16) $(line:5)] $(level:5) - $(message)"

let pattern h f p =
  h, f, Event.render p

let style = [
  "<style type=\"text/css\">" ;
  "table.sample {" ;
  "  border-width: 1px;" ;
  "  border-style: solid;" ;
  "  border-color: black;" ;
  "  border-collapse: collapse;" ;
  "  background-color: white;" ;
  "}" ;
  "table.sample th {" ;
  "  border-width: 1px;" ;
  "  padding: 3px;" ;
  "  border-style: solid;" ;
  "  border-color: black;" ;
  "  background-color: white;" ;
  "}" ;
  "table.sample td {" ;
  "  border-width: 1px;" ;
  "  padding: 3px;" ;
  "  border-style: solid;" ;
  "  border-color: black;" ;
  "  background-color: white;" ;
  "}" ;
  "</style>"
]

let html =
  [ "<html>" ;
    "<head>" ;
    "<title>Log</title>" ] @
  style @
  [ "</head>" ;
    "<body>" ;
    "<p align=\"center\">" ;
    "<table class=\"sample\">" ;
    ("<tr>" ^
     "<th>Identifier</th>" ^
     "<th>Time</th>" ^
     "<th>Millis</th>" ^
     "<th>Level</th>" ^
     "<th>File</th>" ^
     "<th>Message</th>" ^
     "</tr>") ],
  [ "</table>" ;
    "</p>" ;
    ("<p style=\"font-size: smaller; text-align: center;\">Generated by <a href=\"http://bolt.x9c.fr\">Bolt " ^ Version.value ^ "</a></p>") ;
    "</body>" ;
    "</html>" ],
  Event.render ("<tr style=\"font-family: monospace;\">" ^
                "<td align=\"right\">$(id)</td>" ^
                "<td>$(hour):$(min):$(sec)</td>" ^
                "<td align=\"right\">$(relative)</td>" ^
                "<td>$(level)</td>" ^
                "<td><pre>$(filebase:-24) $(line:4)</pre></td>" ^
                "<td>$(message)</td>" ^
                "</tr>")

let csv sep l =
  let render e =
    let b = Event.bindings e in
    let values = List.map (fun k -> try List.assoc k b with _ -> "") l in
    String.concat sep values in
  ([], [], render)

let () =
  List.iter
    (fun (x, y) -> register x y)
    [ "minimal",       minimal ;
      "simple",        simple ;
      "default",       default ;
      "html",          html ]