Source file log.ml

(*********************************************************************************)
(*                Stog                                                           *)
(*                                                                               *)
(*    Copyright (C) 2012-2024 INRIA All rights reserved.                         *)
(*    Author: Maxence Guesdon, INRIA Saclay                                      *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU General Public License as                    *)
(*    published by the Free Software Foundation, version 3 of the License.       *)
(*                                                                               *)
(*    This program 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 General Public License for more details.                               *)
(*                                                                               *)
(*    You should have received a copy of the GNU General Public                  *)
(*    License along with this program; if not, write to the Free Software        *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    As a special exception, you have permission to link this program           *)
(*    with the OCaml compiler and distribute executables, as long as you         *)
(*    follow the requirements of the GNU GPL in regard to all of the             *)
(*    software in the executable aside from the OCaml compiler.                  *)
(*                                                                               *)
(*    Contact: Maxence.Guesdon@inria.fr                                          *)
(*                                                                               *)
(*********************************************************************************)

let src = Logs.Src.create "stog"

let pp_loc fmt loc =
  Format.pp_print_string fmt
    (Xtmpl.Xml.string_of_loc loc)

let loc_tag = Logs.Tag.def
  ~doc:"location" "loc" pp_loc

type ('a, 'b) msgf =
  (?loc:Xtmpl.Xml.loc ->
   ?header:string ->
     ?tags:Logs.Tag.set ->
     ('a, Stdlib.Format.formatter, unit, 'b) Stdlib.format4 -> 'a) -> 'b

let with_loc m ?loc ?header ?tags x =
  let tags =
    match loc, tags with
    | None, None -> None
    | None, Some _ -> tags
    | Some loc, None -> Some (Logs.Tag.(add loc_tag loc empty))
    | Some loc, Some t -> Some (Logs.Tag.add loc_tag loc t)
  in
  m ?header ?tags x

let p logf f =
  let g m = f (with_loc m) in
  logf g

let app f = p Logs.app f
let err ?fatal f =
  p Logs.err f;
  match fatal with
  | None -> ()
  | Some n -> exit n

let warn f = p Logs.warn f
let info f = p Logs.info f
let debug f = p Logs.debug f

let set_level_of_string s =
  match Logs.level_of_string s with
  | Ok l -> Logs.set_level ~all:true l
  | Error (`Msg msg) -> failwith msg

(*
module Sset = Set.Make (struct type t = string let compare = String.compare end);;
let seen_warnings = ref Sset.empty;;
let warn f =
  let b = Buffer.create 256 in
  let fmt = Format.formatter_of_buffer b in
  f (fun u -> Format.kfprintf fmt u);
  Format.pp_print_flush fmt () ;
  let s = Buffer.contents b in
  Buffer.clear b;
  warn (fun m -> m "%s" s)
  *)