├── .gitignore ├── CHANGES ├── LICENSE ├── Makefile ├── README.md ├── dolog.opam ├── dune-project └── src ├── dune ├── example.ml ├── log.ml ├── log.mli └── test.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _build/ 2 | dolog.install 3 | src/.merlin 4 | -------------------------------------------------------------------------------- /CHANGES: -------------------------------------------------------------------------------- 1 | 4.0.0 2 | * the build system was switched from oasis to dune 3 | 3.0.0 4 | * simpler signatures: ('a, 'b, 'c) format instead of ('a, 'b, 'c, 'c) format4 5 | 2.0.0 6 | * it is easier to specify a new color mapping 7 | 1.0.0 8 | * removed logging statements taking a lazy string as a parameter 9 | * simpler log function 10 | * updated copyright 11 | * corrected ocamldoc 12 | 0.6.0 13 | * exposed string_of_level 14 | * added level_of_string 15 | 0.5.0 16 | * Make printf-like functions lazy 17 | * more tests 18 | 0.3.0 (trunk) 19 | * Clean the build system 20 | * Expose `Log.log` to the user 21 | * Add a functorial interface to handle sections 22 | * Add printf-like functions 23 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2021, Francois Berenger. 2 | Tsuda laboratory, Tokyo university, 3 | 5-1-5 Kashiwa-no-ha, Kashiwa-shi, 4 | Chiba-ken, 277-8561, Japan. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions 8 | are met: 9 | 10 | Redistributions of source code must retain the above copyright notice, 11 | this list of conditions and the following disclaimer. 12 | Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 17 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 18 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 19 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 20 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 21 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED 22 | TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 23 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 24 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 25 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 26 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: build clean edit install reinstall uninstall test 2 | 3 | build: 4 | dune build @install 5 | 6 | clean: 7 | dune clean 8 | 9 | edit: 10 | emacs src/*.ml & 11 | 12 | install: build 13 | dune install 14 | 15 | reinstall: build 16 | dune uninstall 17 | dune install 18 | 19 | uninstall: 20 | dune uninstall 21 | 22 | # tests / example 23 | test: 24 | dune build _build/default/src/test.exe 25 | _build/default/src/test.exe 26 | dune build _build/default/src/example.exe 27 | _build/default/src/example.exe 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | dolog 2 | ===== 3 | 4 | Minimalistic lazy logger in OCaml 5 | 6 | Dolog was initially created for console applications, has 7 | optional coloring of log levels and optional 8 | user-defined prefix of log messages. 9 | 10 | WARNING: dolog uses local time to timestamp messages, _NOT_ GMT. 11 | 12 | src/example.ml and src/test.ml are working examples. 13 | -------------------------------------------------------------------------------- /dolog.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "dolog" 3 | authors: "Francois Berenger" 4 | maintainer: "unixjunkie@sdf.org" 5 | license: "BSD-3-Clause" 6 | homepage: "https://github.com/UnixJunkie/dolog" 7 | bug-reports: "https://github.com/UnixJunkie/dolog/issues" 8 | dev-repo: "git+https://github.com/UnixJunkie/dolog.git" 9 | depends: [ 10 | "ocaml" 11 | "dune" {>= "1.11"} 12 | "base-unix" 13 | ] 14 | build: ["dune" "build" "-p" name "-j" jobs] 15 | synopsis: "The dumb OCaml logging library" 16 | description: """ 17 | Very simple lazy logging library with optional colors. 18 | """ 19 | # url { 20 | # src: "https://github.com/UnixJunkie/dolog/archive/vXXX.tar.gz" 21 | # checksum: "md5=YYY" 22 | # } 23 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.11) 2 | (name dolog) 3 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dolog) 3 | (public_name dolog) 4 | (modules log) 5 | (libraries unix)) 6 | 7 | ;; never installed executables 8 | (executables 9 | (names test example) 10 | (modules test example) 11 | (libraries dolog)) 12 | -------------------------------------------------------------------------------- /src/example.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (c) 2019, Francois Berenger. 2 | * Copyright (c) 2014, INRIA. 3 | * Copyright (c) 2013, Zhang Initiative Research Unit, 4 | * Advance Science Institute, RIKEN 5 | * 2-1 Hirosawa, Wako, Saitama 351-0198, Japan 6 | * All rights reserved. 7 | * 8 | * Redistribution and use in source and binary forms, with or without 9 | * modification, are permitted provided that the following conditions 10 | * are met: 11 | * 12 | * Redistributions of source code must retain the above copyright notice, 13 | * this list of conditions and the following disclaimer. 14 | * Redistributions in binary form must reproduce the above copyright notice, 15 | * this list of conditions and the following disclaimer in the documentation 16 | * and/or other materials provided with the distribution. 17 | * 18 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 21 | * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 22 | * HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 23 | * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED 24 | * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 25 | * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 26 | * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 27 | * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 28 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) 29 | 30 | (* add this line if you upgrade software to dolog >= 4.0.0 *) 31 | module Log = Dolog.Log 32 | 33 | let main () = 34 | 35 | Log.set_log_level Log.DEBUG; 36 | 37 | Log.set_output stdout; 38 | 39 | Log.fatal "%s" " ===== PRINTF-LIKE MESSAGES ===== "; 40 | 41 | Log.fatal "%s" "Look"; 42 | Log.error "%s" "like"; 43 | Log.warn "%s" "it is"; 44 | Log.info "%s" "starting"; 45 | Log.color_on(); 46 | Log.debug "%s" "to be useful ! (^-^)"; 47 | 48 | Log.set_prefix " DAFT"; 49 | Log.fatal "%s" "hello"; 50 | Log.error "%s" "hello"; 51 | Log.warn "%s" "hello"; 52 | Log.clear_prefix (); 53 | Log.info "%s" "hello"; 54 | Log.debug "%s" "hello" 55 | 56 | let () = main() 57 | -------------------------------------------------------------------------------- /src/log.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (c) 2020, Francois Berenger. 2 | * Copyright (c) 2014, INRIA. 3 | * Copyright (c) 2013, Zhang Initiative Research Unit, 4 | * Advance Science Institute, RIKEN 5 | * 2-1 Hirosawa, Wako, Saitama 351-0198, Japan 6 | * All rights reserved. 7 | * 8 | * Redistribution and use in source and binary forms, with or without 9 | * modification, are permitted provided that the following conditions 10 | * are met: 11 | * 12 | * Redistributions of source code must retain the above copyright notice, 13 | * this list of conditions and the following disclaimer. 14 | * Redistributions in binary form must reproduce the above copyright notice, 15 | * this list of conditions and the following disclaimer in the documentation 16 | * and/or other materials provided with the distribution. 17 | * 18 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 21 | * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 22 | * HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 23 | * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED 24 | * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 25 | * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 26 | * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 27 | * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 28 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) 29 | 30 | open Printf 31 | 32 | (* localtime is used to date events, _not_ GMT, BEWARE SCIENTIST *) 33 | 34 | type log_level = 35 | | FATAL 36 | | ERROR 37 | | WARN 38 | | INFO 39 | | DEBUG 40 | 41 | let int_of_level = function 42 | | FATAL -> 4 43 | | ERROR -> 3 44 | | WARN -> 2 45 | | INFO -> 1 46 | | DEBUG -> 0 47 | 48 | let string_of_level = function 49 | | FATAL -> "FATAL" 50 | | ERROR -> "ERROR" 51 | | WARN -> "WARN " 52 | | INFO -> "INFO " 53 | | DEBUG -> "DEBUG" 54 | 55 | let char_of_level = function 56 | | FATAL -> 'F' 57 | | ERROR -> 'E' 58 | | WARN -> 'W' 59 | | INFO -> 'I' 60 | | DEBUG -> 'D' 61 | 62 | let level_of_string = function 63 | | "FATAL" | "fatal" -> FATAL 64 | | "ERROR" | "error" -> ERROR 65 | | "WARN" | "warn" -> WARN 66 | | "INFO" | "info" -> INFO 67 | | "DEBUG" | "debug" -> DEBUG 68 | | str -> failwith ("no such log level: " ^ str) 69 | 70 | type color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White 71 | | Default 72 | 73 | (* ANSI terminal colors for UNIX *) 74 | let color_to_string = function 75 | | Black -> "\027[30m" 76 | | Red -> "\027[31m" 77 | | Green -> "\027[32m" 78 | | Yellow -> "\027[33m" 79 | | Blue -> "\027[34m" 80 | | Magenta -> "\027[35m" 81 | | Cyan -> "\027[36m" 82 | | White -> "\027[37m" 83 | | Default -> "\027[39m" 84 | 85 | let color_reset = "\027[0m" 86 | 87 | (* default log levels color mapping *) 88 | let color_of_level = function 89 | | FATAL -> Magenta 90 | | ERROR -> Red 91 | | WARN -> Yellow 92 | | INFO -> Green 93 | | DEBUG -> Cyan 94 | 95 | (* defaults *) 96 | let level = ref ERROR 97 | let output = ref stderr 98 | let level_to_color = ref color_of_level 99 | let use_color = ref false 100 | let prefix = ref "" 101 | 102 | let set_log_level l = 103 | level := l 104 | 105 | let get_log_level () = 106 | !level 107 | 108 | let set_output o = 109 | output := o 110 | 111 | let set_prefix p = 112 | prefix := p 113 | 114 | let clear_prefix () = 115 | prefix := "" 116 | 117 | let set_color_mapping f = 118 | level_to_color := f 119 | 120 | let color_on () = 121 | use_color := true 122 | 123 | let color_off () = 124 | use_color := false 125 | 126 | let level_to_string lvl = 127 | let s = string_of_level lvl in 128 | if !use_color then 129 | let color = !level_to_color lvl in 130 | (color_to_string color) ^ s ^ (color_reset) 131 | else 132 | s 133 | 134 | let level_to_short_string lvl = 135 | let c = char_of_level lvl in 136 | if !use_color then 137 | let color = !level_to_color lvl in 138 | sprintf "%s%c%s" (color_to_string color) c (color_reset) 139 | else 140 | String.make 1 c 141 | 142 | let short_prefix_builder lvl = 143 | let ts = Unix.gettimeofday() in 144 | let tm = Unix.localtime ts in 145 | let us, _s = modf ts in 146 | sprintf "%02d:%02d:%02d.%02d|%s%s: " 147 | tm.Unix.tm_hour 148 | tm.Unix.tm_min 149 | tm.Unix.tm_sec 150 | (int_of_float (100. *. us)) (* 1/100 s *) 151 | (level_to_short_string lvl) 152 | !prefix 153 | 154 | let timestamp_str lvl = 155 | let ts = Unix.gettimeofday() in 156 | let tm = Unix.localtime ts in 157 | let us, _s = modf ts in 158 | (* example: "2012-01-13 18:26:52.091" *) 159 | sprintf "%04d-%02d-%02d %02d:%02d:%02d.%03d %s%s: " 160 | (1900 + tm.Unix.tm_year) 161 | (1 + tm.Unix.tm_mon) 162 | tm.Unix.tm_mday 163 | tm.Unix.tm_hour 164 | tm.Unix.tm_min 165 | tm.Unix.tm_sec 166 | (int_of_float (1_000. *. us)) 167 | (level_to_string lvl) 168 | !prefix 169 | 170 | let prefix_builder = ref timestamp_str 171 | 172 | let set_prefix_builder f = 173 | prefix_builder := f 174 | 175 | let log lvl fmt = 176 | if int_of_level lvl >= int_of_level !level then 177 | let now = !prefix_builder lvl in 178 | fprintf !output ("%s" ^^ fmt ^^ "\n%!") now 179 | else 180 | ifprintf !output fmt 181 | 182 | let fatal fmt = log FATAL fmt 183 | let error fmt = log ERROR fmt 184 | let warn fmt = log WARN fmt 185 | let info fmt = log INFO fmt 186 | let debug fmt = log DEBUG fmt 187 | -------------------------------------------------------------------------------- /src/log.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (c) 2014, INRIA. 2 | * Copyright (c) 2013, Zhang Initiative Research Unit, 3 | * Advance Science Institute, RIKEN 4 | * 2-1 Hirosawa, Wako, Saitama 351-0198, Japan 5 | * All rights reserved. 6 | * 7 | * Redistribution and use in source and binary forms, with or without 8 | * modification, are permitted provided that the following conditions 9 | * are met: 10 | * 11 | * Redistributions of source code must retain the above copyright notice, 12 | * this list of conditions and the following disclaimer. 13 | * Redistributions in binary form must reproduce the above copyright notice, 14 | * this list of conditions and the following disclaimer in the documentation 15 | * and/or other materials provided with the distribution. 16 | * 17 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 18 | * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 19 | * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 20 | * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 21 | * HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 22 | * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED 23 | * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 24 | * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 25 | * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 26 | * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 27 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) 28 | 29 | (** {2 Logger} *) 30 | 31 | (** {4 Log levels} *) 32 | 33 | type log_level = FATAL | ERROR | WARN | INFO | DEBUG 34 | 35 | val string_of_level: log_level -> string 36 | val level_of_string: string -> log_level 37 | 38 | (** {4 Setup} *) 39 | 40 | val set_log_level: log_level -> unit 41 | val get_log_level: unit -> log_level 42 | val set_output: out_channel -> unit 43 | val set_prefix: string -> unit 44 | val clear_prefix: unit -> unit 45 | val set_prefix_builder: (log_level -> string) -> unit 46 | 47 | (** create a short timestamp prefix *) 48 | val short_prefix_builder: log_level -> string 49 | 50 | (** {4 Printf-like logging primitives} *) 51 | 52 | val log: log_level -> ('a, out_channel, unit, unit) format4 -> 'a 53 | 54 | val fatal: ('a, out_channel, unit) format -> 'a 55 | val error: ('a, out_channel, unit) format -> 'a 56 | val warn : ('a, out_channel, unit) format -> 'a 57 | val info : ('a, out_channel, unit) format -> 'a 58 | val debug: ('a, out_channel, unit) format -> 'a 59 | 60 | (** {4 Coloring of log levels (optional)} *) 61 | 62 | type color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White 63 | | Default 64 | 65 | val color_on: unit -> unit 66 | val color_off: unit -> unit 67 | val set_color_mapping: (log_level -> color) -> unit 68 | -------------------------------------------------------------------------------- /src/test.ml: -------------------------------------------------------------------------------- 1 | 2 | (* add this line if you upgrade software to dolog >= 4.0.0 *) 3 | module Log = Dolog.Log 4 | 5 | let () = 6 | Log.set_log_level Log.DEBUG; 7 | Log.color_on(); 8 | Log.fatal "%s" "Look"; 9 | Log.error "%s" "like"; 10 | Log.warn "%s" "it is"; 11 | Log.info "%s" "starting"; 12 | Log.debug "%s" "to be useful ! (^-^) w/ colors"; 13 | Log.color_off(); 14 | Log.fatal "%s" "Look"; 15 | Log.error "%s" "like"; 16 | Log.warn "%s" "it is"; 17 | Log.info "%s" "starting"; 18 | Log.debug "%s" "to be useful ! (^-^) black and white"; 19 | Log.(set_prefix_builder short_prefix_builder); 20 | Log.color_on(); 21 | Log.fatal "%s" "Look"; 22 | Log.error "%s" "like"; 23 | Log.warn "%s" "it is"; 24 | Log.info "%s" "starting"; 25 | Log.debug "%s" "to be useful ! (^-^) short w/ colors"; 26 | Log.color_off(); 27 | Log.fatal "%s" "Look"; 28 | Log.error "%s" "like"; 29 | Log.warn "%s" "it is"; 30 | Log.info "%s" "starting"; 31 | Log.debug "%s" "to be useful ! (^-^) short black and white"; 32 | Unix.sleepf 0.1; 33 | Log.debug "%s" "0.1s later" 34 | --------------------------------------------------------------------------------