open Lwt
open XHTML.M
open Eliom_services
open Eliom_parameters
open Eliom_predefmod.Xhtml

type tutee = { name : string; type_of_tutoring : string; phone : string;
	       rate : int } with orm

type tutee_session = { year : int; month : int; day : int;
		       duration : int; collected : int; tutee : tutee } with orm
 
let none_tutee = { name="None Available"; type_of_tutoring=""; phone=""; rate=0 }

let db_name = "/tmp/tutees.db"

(* Page Helpers *)
let now () = let t = Unix.localtime (Unix.time ()) in
  (t.Unix.tm_year, (t.Unix.tm_mon + 1 ,t.Unix.tm_mday))

let sort_sessions = BatList.sort ~cmp:(fun s1 s2 -> compare s1.day s2.day)

let html_page body_html =
  return
    (html
       (head (title (pcdata "")) [] )
       (body body_html))
     
let summarize ?(year = (-1)) ?(month = (-1)) db = 
    let ses = match (year,month) with
      |((-1),(-1)) -> tutee_session_get db
      |(y,m) -> tutee_session_get ~year:(`Eq y) ~month:(`Eq m) db in
      BatList.group (fun a b -> String.compare a.tutee.name b.tutee.name) ses

let timesheet_func sp yr mo = 
  let db_ses = tutee_session_init_read_only db_name in
  let grouped = summarize ~year:yr ~month:mo db_ses in
  let summap f l = BatList.sum (List.map f l) in
  let disp_session s = [pcdata ((BatString.join "." 
				  (List.map string_of_int [s.year;s.month;s.day])) 
				^ " for " ^ (string_of_int s.duration) ^ "hr of " 
				^ s.tutee.type_of_tutoring ^ " tutoring, ($" ^ (string_of_int s.collected)
				^ " collected)"); br ()] in
  let ts_data = List.map (fun grp -> 
			    let gp = sort_sessions grp in
			    let tut = (List.hd gp).tutee in
			    let total = summap (fun s -> s.duration * tut.rate) gp in
			    let collected = summap (fun s -> s.collected) gp in
			      (tut.name, (total, (collected, gp)))) grouped in
    (List.map (fun (name, (total, (collected, seslist))) ->
		 div (List.flatten
			[[strong [pcdata name; pcdata ": "]; br ()];
			 (List.flatten (List.map disp_session seslist));
			 [pcdata (("Subtotal: $" ^ (string_of_int total))
					 ^ " ($" ^ (string_of_int collected) ^ " collected)"); 
			  br ()]])) ts_data)
      @[div [h3 [br (); pcdata ("Total: $" ^ (string_of_int (summap (fun (_,(t,(_,_))) -> t) ts_data)) 
				^ " ($" ^ (string_of_int (summap (fun (_,(_,(c,_))) -> c) ts_data)) ^ " collected)"
				^ " (" ^ (string_of_int (summap (fun s -> s.duration) (List.concat grouped))) ^ " hrs)")]]]


(* Marshalling code *)
let string_of_ses s = 
  String.concat "." ((List.map string_of_int [s.year; s.month; s.day; s.duration; s.collected])@[s.tutee.name])
let ses_of_string s =
  let db_ses = tutee_session_init db_name in
    match (BatString.nsplit s ".") with
      |[y;m;d;dur;c;name] -> 
	 List.hd (tutee_session_get ~year:(`Eq (int_of_string y)) ~month:(`Eq (int_of_string m)) 
		    ~day:(`Eq (int_of_string d)) ~duration:(`Eq (int_of_string dur)) ~collected:(`Eq (int_of_string c))
		    ~custom:(fun s -> (String.compare s.tutee.name name) == 0) db_ses) (* will error if no session found *)
      |_ -> raise Not_found

let string_of_tutee t = t.name
let tutee_of_string s = 
  let db_tut = tutee_init db_name in
    match (tutee_get ~name:(`Eq s) db_tut) with
      |[t] -> t
      |_ -> raise Not_found

(* Actions *)
let delete_action =
  Eliom_predefmod.Action.register_new_post_coservice'
    ~post_params:(user_type ses_of_string string_of_ses "session")
    (fun sp () entry ->
       let db = tutee_session_init db_name in
	 tutee_session_delete db entry;
	 Lwt.return ())

let record_action =
  Eliom_predefmod.Action.register_new_post_coservice'
    ~post_params:(int "year" ** (int "month" ** (int "day" ** (int "duration" ** (int "collected" ** (user_type tutee_of_string string_of_tutee "tutee"))))))
    (fun _ () (y, (mo, (da, (dur, (c, tut))))) -> 
       let t = { year=y; month=mo; day=da; duration=dur; collected=c; tutee=tut } in
       let db = tutee_session_init db_name in
	 tutee_session_save db t;
	 Lwt.return ())

(* Forms *)
let record_form = 
  let make_tutees tutees t_name =
    match (List.length tutees) with
      |0 -> user_type_select ~name:t_name string_of_tutee (Option ([a_disabled `Disabled], none_tutee, None, true)) []
      |1 -> user_type_select ~name:t_name string_of_tutee (Option ([], (List.hd tutees), None, false)) []
      |_ -> user_type_select ~name:t_name string_of_tutee (Option ([], (List.hd tutees), None, false))
	 (List.map (fun t -> (Option ([], t, None, false))) (List.tl tutees))
  in
  let db_tut = tutee_init db_name in
  let _ = tutee_session_init db_name in (* initialize the database *)
  (fun (year_n, (month_n, (day_n, (dur_n, (collected_n, (tutee_n)))))) ->
     let (year,(month,day)) = now () in
       [p [pcdata "Year: ";
	   int_select ~name:year_n (Option ([], 2010, None, 2010 = year)) [];
	   pcdata "Month: ";
	   int_select ~name:month_n (Option ([], 1, None, 1 = month)) 
	     (List.map (fun m -> (Option ([], m, None, m = month))) 
		(BatList.init 11 ((+) 1)));
	   pcdata "Day: ";
	   int_select ~name:day_n (Option ([], 1, None, 1 = day)) 
	     (List.map (fun d -> (Option ([], d, None, d = day))) 
		(BatList.init 30 ((+) 1)));
	   pcdata "Duration: ";
	   int_select ~name:dur_n (Option ([], 1, None, true))
	     (List.map (fun m -> (Option ([], m, None, false))) 
		(BatList.init 3 ((+) 1)));
	   pcdata "Collected: ";
	   int_input ~input_type:`Text ~name:collected_n ();
	   pcdata "Tutee: ";
	   make_tutees (tutee_get db_tut) tutee_n;
	   string_input ~input_type:`Submit ~value:"Record" ()]])  

let yearmonth_form typ = 
  (fun (year_n, month_n) ->
     [p [pcdata "Year: ";
	 int_select ~name:year_n (Option ([], 2010, None, true)) [];
	 pcdata "Month: ";
	 int_select ~name:month_n (Option ([], 1, None, false)) 
	   (List.map (fun m -> (Option ([], m, None, if m == 5 then true else false))) 
	      [2;3;4;5;6;7;8;9;10;11;12]);
	 string_input ~input_type:`Submit ~value:typ ()]])

(* Url Handlers *)		    
let timesheet =
  new_service
    ~path:["timesheet"]
    ~get_params:(suffix (int "year" ** int "month"))
    ()

let calendar = 
  register_new_service
    ~path:["calendar"]
    ~get_params:(suffix (int "year" ** int "month"))
    (fun sp (year,month) () ->
       let db_session = tutee_session_init db_name in
       let sessions = sort_sessions (tutee_session_get ~year:(`Eq year) ~month:(`Eq month) db_session) in
       let rec acculm cur nex = match cur,nex with
	 |((n,cur_d)::res),(nex_d::n_res) ->
	    if nex_d.day = n 
	    then acculm ((n, nex_d :: cur_d)::res) n_res
	    else
	      List.concat 
		[[(n,cur_d)];
		 (BatList.init (nex_d.day - n - 1) (fun m -> (n+m+1,[])));
		 (acculm [(nex_d.day,nex_d::[])] n_res)]
	 |_,[] -> cur
	 |[],_ -> [] in
       let by_day = acculm [(1, [])] sessions in
       let start_of_month = 
	 match Unix.mktime {Unix.tm_sec = 0; Unix.tm_min = 0; Unix.tm_hour = 0; Unix.tm_mday = 1;
			    Unix.tm_mon = (month - 1); Unix.tm_year = year; 
			    Unix.tm_wday = 0; Unix.tm_yday = 0; Unix.tm_isdst = false} with
	   |(_, t) -> t.Unix.tm_wday in
       let fmtted = 
	 List.concat 
	   [(BatList.drop 1 (BatList.init start_of_month (fun _ -> ("",[]))));
	     List.map (fun (d, ls) -> ((string_of_int d),ls)) by_day] in
       let rec grouped lst = 
	 if List.length lst > 7 
	 then (BatList.take 7 lst)::(grouped (BatList.drop 7 lst))
	 else [lst] in
	 html_page
	   [h2 [pcdata (string_of_int month)];
	    table (tr (th [pcdata "Sunday"]) 
		     (List.map (fun d -> th [pcdata d]) 
			["Monday";"Tuesday";"Wednesday";"Thursday";"Friday";"Saturday"]))
	      (List.map
		 (fun week -> 
		    let fmt = List.map 
		      (fun (n,ses) -> td (BatList.interleave
					    (br ()) 
					    ((pcdata n)::(List.map 
							    (fun s -> 
							       pcdata (s.tutee.name ^ " " ^ (string_of_int s.duration)))
							    ses))))
		      week in
		      tr (List.hd fmt) (List.tl fmt))
		 (grouped fmtted))])

let summary =
  register_new_service
    ~path:[""]
    ~get_params:unit
    (fun sp () () ->
       let del s = 
	 post_form delete_action sp
	   (fun s_name ->
	      [div [user_type_input ~input_type:`Hidden ~name:s_name ~value:s string_of_ses ();
		    string_input ~input_type:`Submit ~value:"x" ()]]) () in
       let db = tutee_session_init_read_only db_name in
       let grouped = summarize db in
	 html_page [h2 [pcdata "Summary!"];
		    div [post_form record_action sp record_form ()];
		    div [get_form timesheet sp (yearmonth_form "Timesheet")];
		    div [get_form calendar sp (yearmonth_form "Calendar")];
		    div (List.map (fun sess ->
				     let t = List.hd sess in
				       div ([br (); strong [pcdata t.tutee.name]; br ()]
					  @(List.flatten
					      (BatList.interleave [br ()] 
						 (List.map (fun s -> [pcdata (string_of_ses s); del s]) sess))))) grouped)])

let _ =
  register timesheet
    (fun sp (year,month) () ->
       html_page [h2 [pcdata "Timesheet for "; pcdata (string_of_int year);
		      pcdata "."; pcdata (string_of_int month)];
		  div (timesheet_func sp year month)])