(* report.ml - Don Yang (uguu.org)

   10/06/07
                                                                           *)

(* Show percentage of total time if event exceeds this threshold *)
let show_percent_threshold = 0.01;;

(* Add (event, duration) pair to map *)
let update_map_entry event_map event duration =
   try
      let t = Hashtbl.find event_map event in
      Hashtbl.replace event_map event (t +. duration)
   with Not_found -> Hashtbl.add event_map event duration;;

(* Get duration for a single event *)
let update_event_map (event_map, last_event) current_event =
   (
      match last_event
      with (time, event)
         when event <> Log.start_marker &&
              event <> Log.end_marker ->
         update_map_entry event_map
            event ((fst current_event) -. (fst last_event))
      | _ -> ()
   );
   (event_map, current_event);;

(* Get (event, time) pairs from log *)
let get_event_map event_log =
   let event_map = Hashtbl.create 128 in
   fst (List.fold_left
      update_event_map (event_map, (0.0, Log.end_marker)) event_log);;

(* Update prefix map for a single event *)
let update_prefix_map skip_parent event duration (prefix_map, child_map) =
   let prefix = Strutil.first_word event skip_parent in
   if prefix <> "" then
   (
      update_map_entry prefix_map prefix duration;
      (
         let child_set =
            try Hashtbl.find child_map prefix
            with Not_found ->
            (
               let new_set = Hashtbl.create 1 in
               Hashtbl.add child_map prefix new_set;
               new_set
            ) in
         Hashtbl.add child_set event ()
      );
   )
   else ();
   (prefix_map, child_map);;

(* Group events and times by prefixes *)
let group_by_prefix event_map skip_parent =
   let size_hint = Hashtbl.length event_map in
   Hashtbl.fold (update_prefix_map skip_parent) event_map
                ((Hashtbl.create size_hint), (Hashtbl.create size_hint));;

(* Compare two (event, duration) pairs, longest duration first *)
let compare_events (event1, time1) (event2, time2) =
   let compare_time = compare time2 time1 in
   if compare_time <> 0 then compare_time else (compare event1 event2);;

(* Convert hash table elements to list *)
let hashtable_to_list table =
   let prepend_to_list key value buffer = (key, value) :: buffer in
   Hashtbl.fold prepend_to_list table [];;

(* Convert (event, duration) map to sorted list *)
let serialize_to_sorted_list event_map =
   List.fast_sort compare_events (hashtable_to_list event_map);;

(* Copy a subset of a hash table, using indices from another table *)
let copy_hashtable_subset table subset =
   let copy_item key _ output =
      (Hashtbl.add output key (Hashtbl.find table key); output) in
   Hashtbl.fold copy_item subset (Hashtbl.create (Hashtbl.length subset));;

(* Output times for a single event *)
let output_event level event time total =
   Printf.printf "%s%s: %s"
      (String.make (level * 3) ' ')
      (Time.format_time_length time)
      event;
   if total > 0. && (level == 0 || time >= total *. show_percent_threshold)
   then
      Printf.printf "  [%.1f%%]" (100. *. time /. total)
   else ();
   print_newline();;

(* Show times for events with same prefix *)
let rec show_prefix_stats event_map total skip_parent level child_map
                          (prefix, time) =
   (* Show toplevel event *)
   let child_set = Hashtbl.find child_map prefix in
   let heading_text_full = Strutil.longest_prefix child_set in
   let heading_text_suffix =
      String.sub heading_text_full skip_parent
                 ((String.length heading_text_full) - skip_parent) in
   output_event level heading_text_suffix time total;

   (* Show subevents *)
   if Hashtbl.length child_set > 1 then
   (
      show_sub_report (copy_hashtable_subset event_map child_set)
                      total
                      (skip_parent + (String.length heading_text_suffix) + 1)
                      (level + 1);
      
      (* Add an extra newline to make toplevel events stand out *)
      if level = 0 then print_newline () else ()
   )
   else ()

(* Show times for a subset of events *)
and show_sub_report event_map total skip_parent level =
   let (prefix_map, child_map) = group_by_prefix event_map skip_parent in
   let sorted_prefixes = serialize_to_sorted_list prefix_map in
   ignore
   (
      List.iter (show_prefix_stats event_map total skip_parent level child_map)
                sorted_prefixes
   );;

(* Show summary report *)
let show_report events =
   let event_map = get_event_map events in
   let total = Hashtbl.fold (fun _ t t0 -> t0 +. t) event_map 0. in
   print_string "Total time: ";
   print_string (Time.format_time_length total);
   print_newline ();
   show_sub_report event_map total 0 0;;