Merge pull request #82 from jonludlam/honest-log

Honest Log signature/modules.

lib/s.ml

@@ -46,11 +46,11 @@ type traced_operation = [
 type traced_operation_list = traced_operation list with sexp
 
 module type LOG = sig
-  val debug : ('a, unit, string, unit) format4 -> 'a
-  val info  : ('a, unit, string, unit) format4 -> 'a
-  val error : ('a, unit, string, unit) format4 -> 'a
+  val debug : ('a, unit, string, unit Lwt.t) format4 -> 'a
+  val info : ('a, unit, string, unit Lwt.t) format4 -> 'a
+  val error : ('a, unit, string, unit Lwt.t) format4 -> 'a
 
-  val trace: traced_operation list -> unit
+  val trace: traced_operation list -> unit Lwt.t
 end
 
 type error = [

lib/vg.ml

@@ -669,32 +669,31 @@ let read flush_interval devices flag : vg result Lwt.t =
     | `Journalled ->
       begin match find t _redo_log_name with
       | None ->
-        Log.error "VG is set to Journalled mode but there is no %s" _redo_log_name;
-        return t
+        Lwt.bind (Log.error "VG is set to Journalled mode but there is no %s" _redo_log_name) (fun () ->
+            return t)
       | Some lv ->
         begin let open Lwt in
         Volume.connect lv
         >>= function
         | `Ok disk ->
           let open Lwt in
-          Log.info "Enabling redo-log on volume group";
-          Redo_log.start ~name:_redo_log_name ~client:"mirage-block-volume" ~flush_interval disk (fun ops -> Lwt.map error_to_msg (perform ops))
-          >>= fun r ->
-          let open IO.FromResult in
-          Redo_log.open_error r
-          >>= fun r ->
-          (* NB the metadata we read in is already out of date! *)
-          return { t with metadata = !on_disk_metadata; redo_log = Some r }
+          Lwt.bind (Log.info "Enabling redo-log on volume group") (fun () ->
+              Redo_log.start ~name:_redo_log_name ~client:"mirage-block-volume" ~flush_interval disk (fun ops -> Lwt.map error_to_msg (perform ops))
+              >>= fun r ->
+              let open IO.FromResult in
+              Redo_log.open_error r
+              >>= fun r ->
+              (* NB the metadata we read in is already out of date! *)
+              return { t with metadata = !on_disk_metadata; redo_log = Some r })
         | `Error _ ->
           let open IO in
-          Log.error "Failed to connect to the redo log volume";
-          return t
+          Lwt.bind (Log.error "Failed to connect to the redo log volume") (fun () -> return t)
         end
       end
     end
   | _ ->
-    Log.error "Failed to read headers to discover whether we're in Journalled mode";
-    return t
+    Lwt.bind (Log.error "Failed to read headers to discover whether we're in Journalled mode") 
+      (fun () -> return t)
 
 let connect ?(flush_interval=120.) devices flag = read flush_interval devices flag
 

lib_test/vg_test.ml

@@ -18,15 +18,17 @@ open Vg
 open Lwt
 
 module Log = struct
-  let debug fmt = Printf.ksprintf (fun s -> print_endline s) fmt
-  let info  fmt = Printf.ksprintf (fun s -> print_endline s) fmt
-  let error fmt = Printf.ksprintf (fun s -> print_endline s) fmt
+  let debug fmt = Lwt_log.debug_f fmt
+  let info  fmt = Lwt_log.info_f fmt
+  let error fmt = Lwt_log.error_f fmt
 
-  let trace _ = ()
+  let trace _ = Lwt.return ()
 
   let _ =
-    debug "This is the debug output";
-    info "This is the info output";
+    debug "This is the debug output"
+    >>= fun () ->
+    info "This is the info output"
+    >>= fun () ->
     error "This is the error output"
 end
 

src/impl.ml

@@ -89,11 +89,11 @@ let with_block filename f =
     Lwt.catch (fun () -> f x) (fun e -> Block.disconnect x >>= fun () -> fail e)
 
 module Log = struct
-  let debug fmt = Printf.ksprintf (fun s -> print_endline s) fmt
-  let info  fmt = Printf.ksprintf (fun s -> print_endline s) fmt
-  let error fmt = Printf.ksprintf (fun s -> print_endline s) fmt
+  let debug fmt = Lwt_log.debug_f fmt
+  let info fmt = Lwt_log.info_f fmt
+  let error fmt = Lwt_log.error_f fmt
 
-  let trace _ = ()
+  let trace _ = Lwt.return ()
 end
 
 let read common filename =