(* Copyright 2012 Tony Garnock-Jones . *) (* This file is part of Hop. *) (* Hop 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, either version 3 of the License, or (at your *) (* option) any later version. *) (* Hop 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 Hop. If not, see . *) open Lwt open Sexp let mtx = Lwt_mutex.create () let write_to_log label body = Lwt_mutex.with_lock mtx (fun () -> try_lwt lwt () = Lwt_io.print label in lwt () = Lwt_io.print ": " in lwt () = output_sexp_human Lwt_io.stdout body in Lwt_io.printl "" with _ -> return ()) let hook = ref write_to_log let info message args = (!hook) "info" (Arr (Sexp.str message :: args)) let warn message args = (!hook) "warn" (Arr (Sexp.str message :: args)) let error message args = (!hook) "error" (Arr (Sexp.str message :: args))