(**************************************************************************)
(*                                                                        *)
(*  Ocamlviz --- real-time profiling tools for Objective Caml             *)
(*  Copyright (C) by INRIA - CNRS - Universite Paris Sud                  *)
(*  Authors: Julien Robert                                                *)
(*           Guillaume Von Tokarski                                       *)
(*           Sylvain Conchon                                              *)
(*           Jean-Christophe Filliatre                                    *)
(*           Fabrice Le Fessant                                           *)
(*  GNU Library General Public License version 2                          *)
(*  See file LICENSE for details                                          *)
(*                                                                        *)
(**************************************************************************)

open Format
open Thread
open Db
open Protocol

let rec go_file_tree fmt i v = 
  let fct s =
    for j  = 0 to i do
      fprintf fmt " "
    done;
    fprintf fmt " -%s\n" s
  in
  match v with
    | Node (s,l) -> if List.length l = 0
      then
	  fct s
      else
	begin
	  fct s;
	  List.iter (fun j -> go_file_tree fmt (i+3) j) l;
	end


let go_file_h fmt = function
  | Int i -> fprintf fmt "%s " (string_of_int i)
  | _ -> assert false

let go_file_value fmt = function
  | t,Int i -> fprintf fmt "t:%f " t; fprintf fmt "value:Int %s " (string_of_int i)
  | t,Float f -> fprintf fmt "t:%f " t; fprintf fmt "value:Float %s " (string_of_float f)
  | t,String s -> fprintf fmt "t:%f " t; fprintf fmt "value:String %s "  s
  | t,Bool b -> fprintf fmt "t:%f " t; fprintf fmt "value:Bool %s " (string_of_bool b)
  | t,Int64 i -> fprintf fmt "t:%f " t; fprintf fmt "value:Int %s " (Int64.to_string i)
  | t,No_value -> fprintf fmt "t:%f " t; fprintf fmt "value:No_value "
  | t,Collected -> fprintf fmt "t:%f " t; fprintf fmt "value:Collected "
  | t,Killed -> fprintf fmt "t:%f " t; fprintf fmt "value:Killed "
  | t,Tree tr -> fprintf fmt "t:%f " t; fprintf fmt "value:\n";go_file_tree fmt 0 tr;fprintf fmt "\n "
  | t,Hashtable (l,nb,empty,max) -> fprintf fmt "t:%f " t; fprintf fmt "value:Hashtable (";go_file_h fmt l;go_file_h fmt nb;go_file_h fmt empty;go_file_h fmt max; fprintf fmt ") "
  | t,Log l -> fprintf fmt "t:%f " t; fprintf fmt "value:Log\n"; List.iter (fun (t,l) -> fprintf fmt "%f : %s \n" t l) l


let go_file_status fmt = function
  | St_active -> fprintf fmt "status:active "
  | St_killed -> fprintf fmt "status:killed "
  | St_collected -> fprintf fmt "status:collected "



let go_file_tag fmt {id=id; name=n; value=v; status = st} =
  let _,st = st in
  fprintf fmt "{id:%d name:%s " id n;
  go_file_value fmt v;
  go_file_status fmt st;
  fprintf fmt "}\n"
    
    
let go_file_table fmt=
  let ts,size = Db.get_heap_total_size () in
  let ta,alive = Db.get_heap_alive_size () in
  let tm,max = Db.get_heap_max_size () in
  let size,alive,max = 
    match size,alive,max with
      | Int64 s,Int64 a,Int64 m -> Int64.to_string s,Int64.to_string a,Int64.to_string m
      | _ -> assert false
  in 
  fprintf fmt "\nGC:\n";
  fprintf fmt "\nsize:%s\nalive:%s\nmax_size:%s\n"size alive max;
  
  let l = Db.get_point_list () in
  if List.length l <> 0 then
    begin
      fprintf fmt "\nPoint:\n";
      List.iter (go_file_tag fmt) l;
    end;

  let l = Db.get_time_list () in
  if List.length l <> 0 then
    begin
      fprintf fmt "\nTime:\n";
      List.iter (go_file_tag fmt) l;
    end;

  let l = Db.get_tag_count_list () in
  if List.length l <> 0 then
    begin
      fprintf fmt "\nTag_count:\n";
      List.iter (go_file_tag fmt) l;
    end;
  
  let l = Db.get_tag_size_list () in
  if List.length l <> 0 then
    begin
      fprintf fmt "\nTag_size:\n";
      List.iter (go_file_tag fmt) l;
    end;

  let l = Db.get_value_int_list () in
  if List.length l <> 0 then
    begin
      fprintf fmt "\nValue_int:\n";
      List.iter (go_file_tag fmt) l;
    end;

  let l = Db.get_value_float_list () in
  if List.length l <> 0 then
    begin
      fprintf fmt "\nValue_float:\n";
      List.iter (go_file_tag fmt) l;
    end;

  let l = Db.get_value_string_list () in
  if List.length l <> 0 then
    begin
      fprintf fmt "\nValue_string:\n";
      List.iter (go_file_tag fmt) l;
    end;

  let l = Db.get_value_bool_list () in
  if List.length l <> 0 then
    begin
      fprintf fmt "\nValue_bool:\n";
      List.iter (go_file_tag fmt) l
    end;

  let l = Db.get_tree_list () in
  if List.length l <> 0 then
    begin
      fprintf fmt "\nTree:\n";
      List.iter (go_file_tag fmt) l
    end;
  
  let l = Db.get_hash_list () in
  if List.length l <> 0 then
    begin
      fprintf fmt "\nHash:\n";
      List.iter (go_file_tag fmt) l
    end;

  let l = Db.get_tag 3 in
  begin
    fprintf fmt "\nLog:\n";
    go_file_tag fmt l
  end;
  
  fprintf fmt "\n#######################################@?\n"
    

let rec print_tree i v = 
  let fct s =
    for j  = 0 to i do
      eprintf " "
    done;
    eprintf " -%s\n" s
  in
  match v with
    | Node (s,l) -> if List.length l = 0
      then
	  fct s
      else
	begin
	  fct s;
	  List.iter (fun j -> print_tree (i+3) j) l;
	end


let print_h = function
  | Int i -> eprintf "%s " (string_of_int i)
  | _ -> assert false

let print_value = function
  | t,Int i -> eprintf "t:%f " t; eprintf "value: %s " (string_of_int i)
  | t,Float f -> eprintf "t:%f " t; eprintf "value: %s " (string_of_float f)
  | t,String s -> eprintf "t:%f " t; eprintf "value: \"%s\" "  s
  | t,Bool b -> eprintf "t:%f " t; eprintf "value: %s " (string_of_bool b)
  | t,Int64 i -> eprintf "t:%f " t; eprintf "value: %s " (Int64.to_string i)
  | t,No_value -> eprintf "t:%f " t; eprintf "value:No_value "
  | t,Collected -> eprintf "t:%f " t; eprintf "value:Collected "
  | t,Killed -> eprintf "t:%f " t; eprintf "value:Killed "
  | t,Tree tr -> eprintf "t:%f " t; eprintf "value:Tree\n";print_tree 0 tr;eprintf "\n "
  | t,Hashtable (l,nb,empty,max) -> eprintf "t:%f " t;eprintf "value:Hashtable ("; print_h l;print_h nb;print_h empty;print_h max; eprintf ")"
  | t,Log l -> eprintf "t:%f " t; eprintf "value:Log\n"; List.iter (fun (t,l) -> eprintf "%f : %s \n" t l) l

let print_status = function
  | St_active -> eprintf "status:active "
  | St_killed -> eprintf "status:killed "
  | St_collected -> eprintf "status:collected "


let print_tag {id=id; name=n; value=v; status = st} =
  eprintf "{id:%d name:%s " id n;
  print_value v;
  let _,st = st in
  print_status st;
  eprintf "}\n"


let print_table fmt=
  let ts,size = Db.get_heap_total_size () in
  let ta,alive = Db.get_heap_alive_size () in
  let tm,max = Db.get_heap_max_size () in
  let size,alive,max = 
    match size,alive,max with
      | Int64 s,Int64 a,Int64 m -> Int64.to_string s,Int64.to_string a,Int64.to_string m
      | No_value,_,_ |_,No_value,_ |_,_,No_value -> "0","0","0"
      | _ -> assert false
  in 
  eprintf "\nGC:\n";
  eprintf "\nsize:%s\nalive:%s\nmax_size:%s\n"size alive max;
  
  let l = Db.get_point_list () in
  if List.length l <> 0 then
    begin
      eprintf "\nPoint:\n";
      List.iter print_tag l;
    end;

  let l = Db.get_time_list () in
  if List.length l <> 0 then
    begin
      eprintf "\nTime:\n";
      List.iter print_tag l;
    end;

  let l = Db.get_tag_count_list () in
  if List.length l <> 0 then
    begin
      eprintf "\nTag_count:\n";
      List.iter print_tag l;
    end;
  
  let l = Db.get_tag_size_list () in
  if List.length l <> 0 then
    begin
      eprintf "\nTag_size:\n";
      List.iter print_tag l;
    end;

  let l = Db.get_value_int_list () in
  if List.length l <> 0 then
    begin
      eprintf "\nValue_int:\n";
      List.iter print_tag l;
    end;

  let l = Db.get_value_float_list () in
  if List.length l <> 0 then
    begin
      eprintf "\nValue_float:\n";
      List.iter print_tag l;
    end;

  let l = Db.get_value_string_list () in
  if List.length l <> 0 then
    begin
      eprintf "\nValue_string:\n";
      List.iter print_tag l;
    end;

  let l = Db.get_value_bool_list () in
  if List.length l <> 0 then
    begin
      eprintf "\nValue_bool:\n";
      List.iter print_tag l
    end;

  let l = Db.get_tree_list () in
  if List.length l <> 0 then
    begin
      eprintf "\nTree:\n";
      List.iter print_tag l
    end;
  
  let l = Db.get_hash_list () in
  if List.length l <> 0 then
    begin
      eprintf "\nHash:\n";
      List.iter print_tag l
    end;

  let l = Db.get_tag 3 in
  begin
    eprintf "\nLog:\n";
    print_tag l
  end;

  eprintf "\n#######################################@?\n"



let () =
  let _ = Thread.create Net.read_data () in
  let f = open_out !Options.output in
  let fmt = Format.formatter_of_out_channel f in
  while true do
    Unix.sleep 1;
    go_file_table fmt;
    if !Options.terminal then print_table ();
  done;
  close_out f

    

(*
Local Variables: 
compile-command: "unset LANG; make -C .."
End: 
*)
