(* Handling of automatic entries for Club meets. *)

open Account

let meets_pool_short_name = "meets-pool"
let lights_pool_short_name = "lamps-pool"
let gear_pool_short_name = "personal-gear-pool"
let srt_kit_pool_short_name = "srt-pool"

type meet_params = { driver_fee : Sumofmoney.amount;
		     non_driver_fee : Sumofmoney.amount;
		     light_fee : Sumofmoney.amount;
		     gear_fee : Sumofmoney.amount;
		     srt_fee : Sumofmoney.amount;
		     breakfast_fee : Sumofmoney.amount;
		     dinner_fee : Sumofmoney.amount }

type meet_state = { driver : bool;
		    fuel : Sumofmoney.amount;
		    food : Sumofmoney.amount;
		    breakfasts : int;
		    dinners : int;
		    light : int;
		    gear : int;
		    srt : int;
                    special_meet_fee : Sumofmoney.amount option }

let find_variable context name vars =
  try
    List.assoc name vars
  with Not_found ->
    Misc.fail ("Variable `" ^ name ^ "' not found " ^ context)

let first_word line =
  if line = "" then raise Not_found
  else
    try
      let index = String.index line ' ' in
        (String.sub line 0 index,
         String.sub line (index + 1) ((String.length line) - index - 1))
    with Not_found -> (line, "")

let first_word_required line msg context =
  try
    first_word line
  with Not_found ->
    Misc.fail (msg ^ " at this point:\n" ^ line ^ "\n" ^ context)

let first_word_required_money line msg context =
  let word, rest = first_word_required line msg context in
    (Units.convert word context, rest)

let first_word_required_int line msg context =
  let word, rest = first_word_required line msg context in
    (int_of_string word, rest)

let rec iter_n n f =
  if n = 0 then ()
  else (f (); iter_n (n - 1) f)

let enter_txn short_name name day month year caver params state =
  let context = "whilst entering transactions for meet " ^ short_name in
  let fee_desc = " for " ^ name in
  let meet_fee = { year = year;
  		   month = month;
		   day = day;
		   creditor = caver;
		   amount = (match state.special_meet_fee with
                               None ->
                                 if state.driver then params.driver_fee
		   	         else params.non_driver_fee
                             | Some fee -> fee);
		   description = (if state.driver
		                  then "Driver's meet fee" ^ fee_desc
		   	          else "Meet fee" ^ fee_desc);
		   automatically_added = true;
		   do_not_symmetrise = true;
                   linked = false }
  in
  let fuel = { year = year;
  	       month = month;
	       day = day;
	       creditor = caver;
	       amount = state.fuel;
	       description = "Fuel for " ^ name;
	       automatically_added = true;
               linked = false;
	       do_not_symmetrise = true }
  in
  let food = { year = year;
  	       month = month;
	       day = day;
	       creditor = caver;
	       amount = state.food;
	       description = "Food shopping for " ^ name;
	       automatically_added = true;
               linked = false;
	       do_not_symmetrise = true }
  in
  let breakfast = { year = year;
  	            month = month;
	            day = day;
	            creditor = meets_pool_short_name;
	            amount = Sumofmoney.negate params.breakfast_fee;
	            description = "One breakfast on " ^ name;
	            automatically_added = true;
                    linked = false;
	            do_not_symmetrise = true }
  in
  let dinner = { year = year;
  	         month = month;
	         day = day;
	         creditor = meets_pool_short_name;
	         amount = Sumofmoney.negate params.dinner_fee;
	         description = "One dinner on " ^ name;
	         automatically_added = true;
                 linked = false;
	         do_not_symmetrise = true }
  in
  let light = { year = year;
  	        month = month;
	        day = day;
	        creditor = lights_pool_short_name;
	        amount = Sumofmoney.negate params.light_fee;
	        description = "One day's light hire on " ^ name;
	        automatically_added = true;
                linked = false;
	        do_not_symmetrise = true }
  in
  let gear = { year = year;
  	       month = month;
	       day = day;
	       creditor = gear_pool_short_name;
	       amount = Sumofmoney.negate params.gear_fee;
	       description = "One day's personal gear hire on " ^ name;
	       automatically_added = true;
               linked = false;
	       do_not_symmetrise = true }
  in
  let srt = { year = year;
  	       month = month;
	       day = day;
	       creditor = srt_kit_pool_short_name;
	       amount = Sumofmoney.negate params.srt_fee;
	       description = "One day's SRT kit hire on " ^ name;
	       automatically_added = true;
               linked = false;
	       do_not_symmetrise = true }
  in
    (* The caver's meet fee, credited to the account for the meet. *)
    Accountdbase.add_txn short_name meet_fee context;
    (* The caver's meet fee, debited from the caver's account. *)
    Accountdbase.add_txn_negated
      caver { meet_fee with creditor = meets_pool_short_name } context;
    (* The caver's meet fee, credited to the meets pool. *)
    Accountdbase.add_txn meets_pool_short_name meet_fee context;
    (if not (Sumofmoney.is_zero state.fuel) then
     begin
       (* Any fuel expenditure by the caver, credited to their account. *)
       Accountdbase.add_txn
         caver { fuel with creditor = meets_pool_short_name } context;
       (* Any fuel expenditure by the caver, debited from the meets pool. *)
       Accountdbase.add_txn_negated meets_pool_short_name fuel context;
       (* Any fuel expenditure by the caver, debited from the account
          for the meet. *)
       Accountdbase.add_txn_negated short_name fuel context
     end);
    (if not (Sumofmoney.is_zero state.food) then
     begin
       (* Any food expenditure by the caver, credited to their account. *)
       Accountdbase.add_txn
         caver { food with creditor = meets_pool_short_name } context;
       (* Any food expenditure by the caver, debited from the meets pool. *)
       Accountdbase.add_txn_negated meets_pool_short_name food context;
       (* Any food expenditure by the caver, debited from the account
          for the meet. *)
       Accountdbase.add_txn_negated short_name food context
     end);
    (* Breakfasts. *)
    iter_n state.breakfasts
      (fun () -> Accountdbase.add_txn caver breakfast context;
      		 Accountdbase.add_txn_negated meets_pool_short_name
		   { breakfast with creditor = caver } context;
		 Accountdbase.add_txn_negated short_name
		   { breakfast with creditor = caver } context);
    (* Dinners. *)
    iter_n state.dinners
      (fun () -> Accountdbase.add_txn caver dinner context;
      		 Accountdbase.add_txn_negated meets_pool_short_name
		   { dinner with creditor = caver } context;
		 Accountdbase.add_txn_negated short_name
		   { dinner with creditor = caver } context);
    (* Lights. *)
    iter_n state.light
      (fun () -> Accountdbase.add_txn caver light context;
      		 Accountdbase.add_txn_negated lights_pool_short_name
		   { light with creditor = caver } context);
    (* Personal gear sets. *)
    iter_n state.gear
      (fun () -> Accountdbase.add_txn caver gear context;
      		 Accountdbase.add_txn_negated gear_pool_short_name
		   { gear with creditor = caver } context);
    (* SRT kits. *)
    iter_n state.srt
      (fun () -> Accountdbase.add_txn caver srt context;
      		 Accountdbase.add_txn_negated srt_kit_pool_short_name
		   { srt with creditor = caver } context)

let date_rexp = Str.regexp "^\\(20[0-1][0-9]\\)-\\([0-9][0-9]\\)-\\([0-9][0-9]\\)"

let parse_date str context =
  if Str.string_match date_rexp str 0 then
    (int_of_string (Str.matched_group 1 str),
     int_of_string (Str.matched_group 2 str),
     int_of_string (Str.matched_group 3 str))
  else Misc.fail ("Bad date " ^ str ^ " (must be YYYY-MM-DD)\n" ^ context)

let load_meet_file params short_name channel =
  Misc.verbose ("Reading meet file: " ^ short_name);
  let context = "whilst reading meet file: " ^ short_name in
  let vars = Variables.read_variables channel in
  let meet_name = find_variable context "name" vars in
  let existing_acct = Accountdbase.lookup_account_nofail short_name in
  let meet_acct =
    if existing_acct = None then
      Account.create short_name meet_name [("group", "Meets")]
    else
      let meets_pool = Accountdbase.lookup_account "meets-pool"
      		         "this account must be present for correct operation"
      in
      let existing_acct' =
        match existing_acct with None -> assert false | Some x -> x
      in
      let prefix = "" in
        Accountdbase.update_account "meets-pool"
	                            (Account.copy existing_acct' meets_pool
				    		  prefix);
	existing_acct'
  in
  let _ = Accountdbase.add_account short_name meet_acct in
  let meet_date = find_variable context "date" vars in
  let year, month, day = parse_date meet_date context in
  let rec read_line () =
    try
      let line = input_line channel in
      if line = "" || String.sub line 0 1 = "#" then
        read_line ()
      else
      let caver, rest = first_word_required line "Short name expected" context
      in
      let rec read_modifiers chars state =
        try
          let word, rest = first_word chars in
	  let context = "whilst reading line:\n" ^ line in
	    match word with
	      "driver" -> read_modifiers rest { state with driver = true }
	    | "non-driver" -> read_modifiers rest { state with driver = false }
	    | "special-meet-fee" ->
	      let fee, rest =
	        first_word_required_money rest "Meet fee expected" context
	      in
	        read_modifiers rest { state with special_meet_fee = Some fee }
	    | "fuel" ->
	      let fuel, rest =
	        first_word_required_money rest "Fuel amount expected" context
	      in
	        read_modifiers rest { state with fuel = fuel }
	    | "food" ->
	      let food, rest =
	        first_word_required_money rest "Food amount expected" context
	      in
	        read_modifiers rest { state with food = food }
	    | "breakfast" ->
	      let breakfasts, rest =
	        first_word_required_int rest "Number of breakfasts expected"
					context
	      in
	        read_modifiers rest { state with breakfasts = breakfasts }
	    | "dinner" ->
	      let dinners, rest =
	        first_word_required_int rest "Number of dinners expected"
					context
	      in
	        read_modifiers rest { state with dinners = dinners }
	    | "light" ->
	      let light, rest =
	        first_word_required_int rest
		                        "Number of days of light use expected"
					context
	      in
	        read_modifiers rest { state with light = light }
	    | "srt" ->
	      let srt, rest =
	        first_word_required_int rest
		                        "Number of days of SRT use expected"
					context
	      in
	        read_modifiers rest { state with srt = srt }
	    | "gear" ->
	      let gear, rest =
	        first_word_required_int rest
		                        "Number of days of gear use expected"
					context
	      in
	        read_modifiers rest { state with gear = gear }
	    | _ -> Misc.fail ("Don't understand first word of: " ^ chars ^
	                      "\n" ^ context)
	with Not_found ->
	begin
	  enter_txn short_name meet_name day month year caver params state;
          read_line ()
	end
      in
        read_modifiers rest { driver = false;
			      fuel = Sumofmoney.zero;
			      food = Sumofmoney.zero;
			      breakfasts = 2;
			      dinners = 1;
			      light = 0;
			      gear = 0;
			      srt = 0;
                              special_meet_fee = None }
    with End_of_file -> ()
  in
    read_line ()

let find_variable_money context name vars =
  Units.convert (find_variable context name vars) context

let process () =
  Misc.verbose "Reading meets config file.";
  try
    let channel = Misc.open_config_file_fail_ok "meets" in
    let vars = Variables.read_variables channel in
    let context = "whilst reading meets config file" in
    let params = { driver_fee = find_variable_money context "driver_fee" vars;
    		   non_driver_fee = find_variable_money context
  		 				        "non_driver_fee" vars;
  		   light_fee = find_variable_money context "light" vars;
  		   gear_fee = find_variable_money context "gear" vars;
  		   srt_fee = find_variable_money context "srt" vars;
  		   breakfast_fee = find_variable_money context "breakfast" vars;
  		   dinner_fee = find_variable_money context "dinner" vars }
    in
      close_in channel;
      Misc.verbose "Processing meets.";
      Misc.iter_files "meets" (load_meet_file params);
      Misc.verbose "Processing meets done."
  with Not_found -> Misc.verbose "No meets config file found; skipping."

