File: splits.ml

package info (click to toggle)
misery 0.2-1.1
  • links: PTS
  • area: main
  • in suites: bullseye, buster, sid, stretch
  • size: 380 kB
  • ctags: 298
  • sloc: ml: 1,295; xml: 180; makefile: 94
file content (128 lines) | stat: -rw-r--r-- 4,951 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
(* Splitting of accounts' intermediate balances across other accounts. *)

open Account
open Unix

let rexp = Str.regexp "^\\([-a-zA-Z0-9_]+\\)\\(,[0-9.]*\\)?$"

(* Format num/denom to a string, avoiding printing decimal places when
   necessary. *)
let format_fraction num denom =
  let n = int_of_float num in
  let d = int_of_float denom in
    if (float_of_int n) = num && (float_of_int d) = denom then
      Printf.sprintf "%d/%d" n d
    else
      Printf.sprintf "%.02f/%.02f" num denom

(* Process splits for a given account. *)
let load_split_file short_name channel =
  Misc.verbose ("Reading split file: " ^ short_name);
  let context = "whilst processing splits for " ^ short_name in
  let acct = Accountdbase.lookup_account short_name context in
  let full_name = Account.full_name acct in
  let total_str = Sumofmoney.to_string_default (Account.total acct) in
  let rec f acc =
    try
      let line = input_line channel in
      if String.length line > 0 then
      begin
        if Str.string_match rexp line 0 then
          let name = Str.matched_group 1 line in
          let factor =
            try
              let x = Str.matched_group 2 line in
                float_of_string (String.sub x 1 (String.length x - 1))
            with Not_found -> 1.0
          in
          let factor_str = Printf.sprintf "%.2f" factor in
          let debug = "  ...debit " ^ name ^ ", factor " ^ factor_str in
            Misc.verbose debug;
            f ((name, factor) :: acc)
        else
          Misc.fail ("Bad line whilst loading splits file `" ^
                     short_name ^ "':\n  " ^ line ^
		     "\n\nThe format is either:\n" ^
		     "short-name\n\nor:\nshort-name,factor\n\nwhere:\n" ^
		     "short-name identifies an account to be in the split;\n" ^
		     "factor is an integer or decimal number that specifies\n" ^
		     "  what proportion to assign to this account.\n" ^
		     "  If omitted, the factor is one.")
      end
      else acc
    with End_of_file -> acc
  in
  let debtors = f [] in
  let total = Account.total acct in
  let total_added = ref Sumofmoney.zero_default in
  let factor_total =
    List.fold_left (fun acc -> fun (_, factor) -> factor +. acc)
                   0.0 debtors
  in
  let tm = Unix.localtime (Unix.time ()) in
    List.iter (fun (debtor_name, factor) ->
                 let amount = Sumofmoney.scale_default factor factor_total
                                                       total
                 in
                 let _ =
                   total_added := Sumofmoney.add_default
                                  !total_added amount
                 in
		 let fraction = format_fraction factor factor_total in
                 let desc =
                   Printf.sprintf
                     "%s of the total from <a href=\"bill-%s.html\">%s</a> (%s)"
                      fraction short_name full_name total_str
                 in
                 let txn_d = { year = tm.tm_year + 1900;
                               month = tm.tm_mon + 1;
			       day = tm.tm_mday;
			       creditor = short_name;
			       amount = Sumofmoney.default_to_normal amount;
                               description = desc;
                               linked = false;
			       automatically_added = true;
			       do_not_symmetrise = true } in
                 let txn_c = { txn_d with
                               creditor = debtor_name;
			       amount = Sumofmoney.default_to_normal (
                                 Sumofmoney.negate_default amount) }
		 in
		 let context = "whilst splitting " ^ full_name ^ ".\n\n" ^
		               "The splits/" ^ short_name ^
			       " file is probably at fault"
		 in
                   Accountdbase.add_txn debtor_name txn_d context;
                   Accountdbase.add_txn short_name txn_c context) debtors;
  if (Sumofmoney.abs_default !total_added) <
     (Sumofmoney.abs_default total) then
    let unlucky =
      match debtors with
        (x, _)::_ -> x
      | _ -> Misc.fail "No entries made for '" ^ short_name ^ "' split"
    in
    let extra = Sumofmoney.subtract_default total !total_added in
    let txn = { year = tm.tm_year + 1900;
                month = tm.tm_mon + 1;
	        day = tm.tm_mday;
                creditor = unlucky;
	        amount = Sumofmoney.default_to_normal
                           (Sumofmoney.negate_default extra);
	        description = "Unlucky: arithmetic error from " ^ short_name ^ " split";
                linked = false;
		automatically_added = true;
		do_not_symmetrise = true } in
    let txn' = { txn with
                 creditor = short_name;
		 amount = Sumofmoney.default_to_normal extra }
    in
    begin
      Accountdbase.add_txn short_name txn context;
      Accountdbase.add_txn unlucky txn' context
    end

let process () =
  Misc.verbose "Processing splits.";
  Misc.iter_files "splits" load_split_file;
  Misc.verbose "Processing splits done."