parvel / parvel_log.ml

open Printf
;

type log_dest =
  [ Channel of out_channel
  | File of string
  | Function of (string -> unit)
  ]
;

type log_level = int
;

value log_level_debug = 1
  and log_level_info = 2
  and log_level_error = 3
  and log_level_no = 4
;

(* with additional spaces *)
value string_of_log_level = fun
  [ 1 -> " debug   "
  | 2 -> " info    "
  | 3 -> " error   "
  | _ -> assert False
  ]
;



type log_dest_state =
  [ LS_channel of out_channel
  | LS_file of string and out_channel
  | LS_function of (string -> unit)
  ]
;

type log_state = (log_dest_state * log_dest * log_level)
;


(* author of original code: ygrek *)
value time_to_buf ?(gmt=False) ?(ms=False) f buf =
  let t = (if gmt then Unix.gmtime else Unix.localtime) f in
  let sec =
    if ms
    then sprintf "%07.4f" (mod_float f 60.)
    else sprintf "%02u" t.Unix.tm_sec
  in
    bprintf buf "%04u-%02u-%02uT%02u:%02u:%s%s"
      (1900 + t.Unix.tm_year)
      (t.Unix.tm_mon+1)
      t.Unix.tm_mday
      t.Unix.tm_hour
      t.Unix.tm_min
      sec
      (if gmt then "Z" else "")
;


value log_gmt = True
  and log_ms = True
;

value write log_state level line =
  match log_state with
  [ (cur_state, _cur_dest, cur_level) ->
      if level < cur_level
      then ()
      else
        let buf = Buffer.create 100 in
        ( time_to_buf ~gmt:log_gmt ~ms:log_ms
           (Unix.gettimeofday ()) buf
        ; Buffer.add_string buf (string_of_log_level level)
        ; Buffer.add_string buf line
        ; match cur_state with
          [ LS_channel c | LS_file _ c ->
              ( Buffer.add_char buf '\n'
              ; Buffer.output_buffer c buf
              ; flush c
              )
          | LS_function f -> f (Buffer.contents buf)
          ]
        )
  ]
;


value default_log_dest = Channel stderr
  and default_log_level = log_level_no
;

value state_of_dest log_dest log_level =
  ( match log_dest with
    [ Channel c -> LS_channel c
    | File fn ->
        let c = open_out_gen
          [ Open_append ; Open_creat ; Open_binary ]
          0o666
          fn
        in
          LS_file fn c
    | Function f -> LS_function f
    ]
  , log_dest
  , log_level
  )
;

value cur_log_state = ref (state_of_dest default_log_dest default_log_level)
;

value debug fmt = ksprintf (write cur_log_state.val log_level_debug) fmt
  and info fmt = ksprintf (write cur_log_state.val log_level_info) fmt
  and error fmt = ksprintf (write cur_log_state.val log_level_error) fmt
;

value string_of_log_dest_state = fun
  [ LS_channel _ -> "<channel>"
  | LS_file fn _ -> sprintf "file %S" fn
  | LS_function _ -> "<function>"
  ]
;


value log_dest_finalize (cur_log_state, _cur_log_dest, _cur_log_level) =
  match cur_log_state with
  [ LS_channel _ | LS_function _ -> ()
  | LS_file _fn c -> close_out c
  ]
;


value set
 : ?log_dest : log_dest -> ?log_level : log_level -> unit -> unit
 = fun ?log_dest ?log_level () ->
     let ((old_log_dest_state, old_log_dest, old_log_level) as old_log_state) =
       cur_log_state.val in
     let () = debug "stopping to log in %s"
       (string_of_log_dest_state old_log_dest_state) in
     let () = log_dest_finalize old_log_state in
     let log_dest = match log_dest with
       [ None -> old_log_dest | Some v -> v ]
     and log_level = match log_level with
       [ None -> old_log_level | Some v -> v ]
     in
     let ((new_log_dest_state, _, _) as new_log_state) =
       state_of_dest log_dest log_level in
     ( cur_log_state.val := new_log_state
     ; debug "starting to log in %s"
         (string_of_log_dest_state new_log_dest_state)
     )
;
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.