";
List.iter (fun acct ->
let fixme_present =
Account.fold_txns (fun flag -> fun txn ->
if flag
then true
else
Str.string_match fixme_rexp txn.description 0)
false acct
in
output_string channel "
";
let must_be_zero =
try Account.lookup_boolean_variable "must_be_zero" acct
with Not_found -> false
in
let total = Account.total acct in
if must_be_zero then
begin
if Sumofmoney.is_zero (Sumofmoney.default_to_normal total) then
output_string channel "
OK"
else
output_string channel "
Not correct"
end
else
begin
(if Sumofmoney.non_negative_default total then
output_string channel "
"
else if Sumofmoney.very_negative_default total then
output_string channel "
"
let emit () =
Misc.verbose "Reading title file.";
let channel = Misc.open_config_file "title" in
try
let title = input_line channel in
Misc.verbose "Preparing to emit the group summary sheet.";
let groups = Accountdbase.group "group" in
let html_channel = Htmlout.create_page "index"
title in
output_string html_channel "
";
Htmlout.finish_page html_channel
with End_of_file ->
Misc.fail "Could not read title (check title file has contents)"
misery-0.2/src/printaccount.mli 0000644 0001750 0001750 00000000142 10754123012 016272 0 ustar wookey wookey (* Dumping of account balance sheets to HTML files. *)
val create_balance_sheets : unit -> unit
misery-0.2/src/main.ml 0000644 0001750 0001750 00000000417 10754123012 014341 0 ustar wookey wookey let _ =
Units.initialize ();
Accountdbase.load_initial_files ();
Meets.process ();
Splits.process ();
Vaccounts.process ();
Vaccounts.process_late ();
Printaccount.create_balance_sheets ();
Groupsummary.emit ();
print_endline "Processed successfully."
misery-0.2/src/misc.mli 0000644 0001750 0001750 00000000536 10754123012 014523 0 ustar wookey wookey (* Miscellaneous functions. *)
val get_root_directory : unit -> string
val open_config_file : string -> in_channel
val open_config_file_fail_ok : string -> in_channel
val iter_files : string -> (string -> in_channel -> unit) -> unit
val format_money : int -> string
val round : float -> float
val verbose : string -> unit
val fail : string -> 'a
misery-0.2/src/vaccounts.ml 0000644 0001750 0001750 00000004117 10754123012 015423 0 ustar wookey wookey open Account
open Unix
let read_headers_from_channel short_name channel =
Misc.verbose ("Reading headers from virtual account file for " ^ short_name);
let name =
begin
try
input_line channel
with End_of_file ->
Misc.fail (
"Couldn't read first line (account name) from virtual account with short name `"
^ short_name ^ "'")
end
in
(name, Variables.read_variables channel)
let load_vaccount_file short_name channel =
let name, vars = read_headers_from_channel short_name channel in
let acct = Account.create_virtual short_name name vars in
let _ = Accountdbase.add_account short_name acct in
let rec f () =
let context = "whilst reading virtual account file `" ^ short_name ^ "'" in
try
let line = input_line channel in
let name, negate =
if String.length line > 0 && String.get line 0 = '-'
then (String.sub line 1 ((String.length line) - 1)), true
else line, false
in
let acct = Accountdbase.lookup_account name context in
let total = Sumofmoney.default_to_normal (Account.total acct) in
let tm = Unix.localtime (Unix.time ()) in
let total_str = if negate then "Negated total" else "Total" in
let txn = { year = tm.tm_year + 1900;
month = tm.tm_mon + 1;
day = tm.tm_mday;
amount = if not negate then total
else Sumofmoney.negate total;
creditor = "phantom";
description = total_str ^ " of account " ^
(Account.full_name acct);
automatically_added = true;
linked = false;
do_not_symmetrise = true }
in
Accountdbase.add_txn short_name txn context;
f ()
with End_of_file -> ()
in
f ()
let process () =
Misc.verbose "Processing virtual accounts.";
Misc.iter_files "vaccounts" load_vaccount_file;
Misc.verbose "Processing of virtual accounts done."
let process_late () =
Misc.verbose "Processing late virtual accounts.";
Misc.iter_files "vaccounts_late" load_vaccount_file;
Misc.verbose "Processing of late virtual accounts done."
misery-0.2/src/meets.ml 0000644 0001750 0001750 00000030762 11371536776 014565 0 ustar wookey wookey (* 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."
misery-0.2/src/vaccounts.mli 0000644 0001750 0001750 00000000073 10754123012 015571 0 ustar wookey wookey val process : unit -> unit
val process_late : unit -> unit
misery-0.2/src/htmlout.ml 0000644 0001750 0001750 00000001432 10754123012 015107 0 ustar wookey wookey (* Utility functions for HTML output. *)
let create_page filename title =
let root = Misc.get_root_directory () in
let path = root ^ "/html/" ^ filename ^ ".html" in
try
let channel = open_out path in
output_string channel "";
output_string channel title;
output_string channel "";
output_string channel "";
output_string channel "\n";
output_string channel "
";
channel
with Sys_error _ -> Misc.fail ("Could not create file " ^ path)
let finish_page channel =
output_string channel "";
close_out channel
misery-0.2/src/sumofmoney.mli 0000644 0001750 0001750 00000001736 10754123012 015774 0 ustar wookey wookey type amount
type default_units_amount
val create : int (* default units *) -> string -> amount
val to_string : amount -> string
val is_negative : amount -> bool
val zero_default : default_units_amount
val zero : amount
val abs_default : default_units_amount -> default_units_amount
val add : amount -> default_units_amount -> default_units_amount
val add_default : default_units_amount -> default_units_amount -> default_units_amount
val negate : amount -> amount
val negate_default : default_units_amount -> default_units_amount
val subtract_default : default_units_amount -> default_units_amount ->
default_units_amount
val scale_default : float -> float -> default_units_amount ->
default_units_amount
val to_string_default : default_units_amount -> string
val non_negative_default : default_units_amount -> bool
val very_negative_default : default_units_amount -> bool
val default_to_normal : default_units_amount -> amount
val is_zero : amount -> bool
misery-0.2/src/groupsummary.mli 0000644 0001750 0001750 00000000031 10754123012 016330 0 ustar wookey wookey val emit : unit -> unit
misery-0.2/src/splits.ml 0000644 0001750 0001750 00000011527 10754123012 014737 0 ustar wookey wookey (* 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 %s (%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."
misery-0.2/src/vaccount.ml 0000644 0001750 0001750 00000000410 10754123012 015230 0 ustar wookey wookey (* Handling of virtual accounts. *)
type vaccount_op = Add | Subtract
type vaccount_entry = Account of string | Group of string
type vaccount = { name : string;
group : string;
entries : (vaccount_op * vaccount_entry) list }
misery-0.2/src/account.ml 0000644 0001750 0001750 00000020647 11371543631 015071 0 ustar wookey wookey (* Handling of a single account. *)
type txn = { year : int;
month : int;
day : int;
creditor : string;
amount : Sumofmoney.amount;
description : string;
automatically_added : bool;
do_not_symmetrise : bool;
linked : bool }
type account = { name : string;
short_name : string;
variables : (string * string) list;
transactions : txn list;
income : Sumofmoney.default_units_amount;
expenditure : Sumofmoney.default_units_amount;
virtual_acct : bool }
let short_name acct = acct.short_name
let create short_name name variables =
{ name = name;
short_name = short_name;
variables = variables;
transactions = [];
income = Sumofmoney.zero_default;
expenditure = Sumofmoney.zero_default;
virtual_acct = false }
let create_virtual short_name name variables =
{ name = name;
short_name = short_name;
variables = variables;
transactions = [];
income = Sumofmoney.zero_default;
expenditure = Sumofmoney.zero_default;
virtual_acct = true }
let is_virtual acct = acct.virtual_acct
(* Read headers from an input channel attached to a file in the initial/
directory. The file pointer should be at the start of the file. *)
let read_headers_from_channel short_name channel =
Misc.verbose ("Reading headers from initial account file for " ^ short_name);
let name =
begin
try
input_line channel
with End_of_file ->
Misc.fail (
"Couldn't read first line (account name) from account with short name `"
^ short_name ^ "'")
end
in
(name, Variables.read_variables channel)
(* Create a transaction list from an input channel representing one of the
files in the initial/ directory. The headers must have been read
already. Returns a list of transactions, the income, and the
expenditure (the latter two in default units). *)
let read_transactions_from_channel account_name channel =
Misc.verbose ("Reading transactions from initial account file for "
^ account_name);
let rexp = Str.regexp "^\\(20[0-1][0-9]\\)-\\([0-9][0-9]\\)-\\([0-9][0-9]\\),\\([!=a-zA-Z0-9-]+\\),\\(-?[a-zA-Z]?[0-9]+\\.[0-9][0-9]\\),\\(.*\\)" in
let blank = Str.regexp "^ *$"
in
let rec f acc income expenditure =
try
let csv = input_line channel in
if String.length csv = 0 || String.sub csv 0 1 = "#"
|| Str.string_match blank csv 0 then
f acc income expenditure
else if Str.string_match rexp csv 0 = true then
let year = int_of_string (Str.matched_group 1 csv) in
let month = int_of_string (Str.matched_group 2 csv) in
let day = int_of_string (Str.matched_group 3 csv) in
let do_not_symmetrise, linked, creditor =
let x = Str.matched_group 4 csv in
if String.get x 0 = '!' then
(true, false, String.sub x 1 ((String.length x) - 1))
else (if String.get x 0 = '=' then
(false, true, String.sub x 1 ((String.length x) - 1))
else
(false, false, x))
in
let description = Str.matched_group 6 csv in
let context = "whilst reading transactions for " ^ account_name in
let amount = Units.convert (Str.matched_group 5 csv) context in
let new_expenditure =
if Sumofmoney.is_negative amount then
Sumofmoney.add (Sumofmoney.negate amount) expenditure
else
expenditure
in
let new_income =
if Sumofmoney.is_negative amount then
income
else
Sumofmoney.add amount income
in
let debug = Printf.sprintf "Adding transaction: %04d-%02d-%02d creditor=%s amount=%s new_income=%s new_expenditure=%s (%s)"
year month day creditor (Sumofmoney.to_string amount)
(Sumofmoney.to_string_default new_income)
(Sumofmoney.to_string_default new_expenditure)
description
in
Misc.verbose debug;
f ({ year = year;
month = month;
day = day;
creditor = creditor;
amount = amount;
description = description;
automatically_added = false;
do_not_symmetrise = do_not_symmetrise;
linked = linked } :: acc)
new_income new_expenditure
else
Misc.fail (
"Malformed line while reading initial/ file for account `" ^
account_name ^ "':\n" ^ csv ^
"\n\nThe format is:\nYYYY-MM-DD,short-name,amount,description\n" ^
"where:\n YYYY is the year; MM is the month; DD is the day;\n" ^
" short-name is the short name of the creditor or debtor;\n" ^
" amount is the sum involved (e.g. 23.40, E3.40, -E7.60);\n" ^
" description is a text string giving the description.")
with End_of_file -> (acc, income, expenditure)
in f [] Sumofmoney.zero_default Sumofmoney.zero_default
(* Create an account structure from an input channel representing one
of the files in the initial/ directory. The file pointer should be
at the start of the file. *)
let create_account_from_channel short_name channel =
Misc.verbose ("Creating account from initial account file " ^ short_name);
let (name, variables) = read_headers_from_channel short_name channel in
let (txns, income, expenditure) =
read_transactions_from_channel name channel
in
{ name = name;
short_name = short_name;
variables = variables;
transactions = txns;
income = income;
expenditure = expenditure;
virtual_acct = false }
(* Return the full name of an account. *)
let full_name acct = acct.name
(* Lookup a variable in an account. *)
(* FIXME ought to be case-insensitive *)
let lookup_variable var acct = List.assoc var acct.variables
let lookup_boolean_variable var acct =
let str = List.assoc var acct.variables in
match String.lowercase str with
"true" -> true
| "false" -> false
| _ -> Misc.fail ("Bad value for boolean variable `" ^ var ^
"' in account `" ^ acct.name ^ "'")
let lookup_integer_variable var acct =
int_of_string (List.assoc var acct.variables)
(* Return an account's balance in default units. *)
let total acct = Sumofmoney.subtract_default acct.income acct.expenditure
let income acct = acct.income
let expenditure acct = acct.expenditure
(* Add a transaction to an account. *)
let add_txn txn acct =
{ acct with
transactions = txn :: acct.transactions;
income = (if Sumofmoney.is_negative txn.amount
then acct.income
else Sumofmoney.add txn.amount acct.income);
expenditure = (if Sumofmoney.is_negative txn.amount
then Sumofmoney.add (Sumofmoney.negate txn.amount)
acct.expenditure
else acct.expenditure)}
(* Add a transaction to an account, but negating the amount. *)
let add_txn_negated txn acct =
let neg_amount = Sumofmoney.negate txn.amount in
{ acct with
transactions = { txn with amount = neg_amount } :: acct.transactions;
income = (if Sumofmoney.is_negative neg_amount
then acct.income
else Sumofmoney.add neg_amount acct.income);
expenditure = (if Sumofmoney.is_negative neg_amount
then Sumofmoney.add (Sumofmoney.negate neg_amount)
acct.expenditure
else acct.expenditure)}
(* Map over the transactions of an account. *)
let map_txns f acct =
{ acct with transactions = List.map f acct.transactions }
(* Fold over the transactions of an account. *)
let fold_txns f init acct = List.fold_left f init acct.transactions
let iter_txns f acct = List.iter f acct.transactions
let txn_compare t1 t2 =
if t1.year > t2.year then 1
else if t1.year < t2.year then -1
else if t1.month > t2.month then 1
else if t1.month < t2.month then -1
else if t1.day > t2.day then 1
else if t1.day < t2.day then -1
else compare t1.creditor t2.creditor
let iter_txns_sorted f acct =
List.iter f (List.sort txn_compare acct.transactions)
let number_of_txns acct = List.length acct.transactions
(* Copy all transactions from src to dest. The copied transactions
are marked as automatically added and "do not symmetrise". The
string "prefix" is added to each description. *)
let copy src dest prefix =
fold_txns (fun cur_acc -> fun txn ->
add_txn ({txn with automatically_added = true;
do_not_symmetrise = true;
description = prefix ^ txn.description})
cur_acc)
dest src
misery-0.2/src/units.ml 0000644 0001750 0001750 00000010265 10754123012 014561 0 ustar wookey wookey module UnitsMap = Map.Make (struct type t = string let compare = compare end)
let units_map = ref UnitsMap.empty
let default_unit = ref ""
let amount_regexp = Str.regexp "^\\(-\\)?\\([a-zA-Z]\\)?\\([0-9]+\\)\\.\\([0-9][0-9]\\)$"
let initialize () =
Misc.verbose "Loading units configuration file.";
let channel = Misc.open_config_file "units" in
let rexp = Str.regexp
"^\\([a-zA-Z]\\),\\([ a-zA-Z0-9]+\\),\\([0-9]+\\.[0-9]*\\)\\(,.\\)?$"
in
try
begin
default_unit := input_line channel;
Misc.verbose ("The default units are: " ^ !default_unit);
while true do
let line = input_line channel in
if Str.string_match rexp line 0 then
let unit_char = Str.matched_group 1 line in
let name = Str.matched_group 2 line in
let factor = Str.matched_group 3 line in
let factor2 =
begin try
let in_terms_of = String.sub (Str.matched_group 4 line) 1 1 in
begin try
fst (UnitsMap.find in_terms_of !units_map)
with Not_found ->
Misc.fail ("Unknown units `" ^ in_terms_of ^
"' used in line: " ^ line ^ " in units.csv")
end
with Not_found -> 1.0
end
in
let final_factor = (float_of_string factor) *. factor2 in
begin
Misc.verbose ("Unit char `" ^ unit_char ^ "' is called `" ^
name ^ "' and is worth " ^
(string_of_float final_factor) ^
" of a default unit.");
units_map := UnitsMap.add unit_char (final_factor, name) !units_map
end
else
Misc.fail ("Malformed units definition: `" ^ line ^ "'\n" ^
"Check the config/units file. The format of each " ^
"line is either:\nunit-char,name,factor\n\nor:\n" ^
"unit-char,name,factor,in-terms-of\n\nwhere:\n" ^
" unit-char is a single character identifying the unit" ^
" being defined\n" ^
" name is a textual name for the unit\n" ^
" factor is a decimal number saying how many default\n" ^
" units there are in the new unit being defined\n" ^
" in-terms-of is a single unit character (say X) defined earlier\n" ^
" in the file. If this is specified, factor specifies\n" ^
" how many X units there are in the new unit being defined.")
done
end
with Sys_error s -> Misc.fail ("Error whilst reading units file: " ^ s)
| End_of_file ->
if !default_unit = "" then
Misc.fail "End-of-file whilst reading default unit"
else
close_in channel
let convert amount context =
if Str.string_match amount_regexp amount 0 then
let negative =
begin try
let _ = Str.matched_group 1 amount
in true
with Not_found -> false
end in
let (factor, name), default =
begin try
let units_str = Str.matched_group 2 amount in
begin try
(UnitsMap.find units_str !units_map), false
with Not_found ->
let names = UnitsMap.fold (fun chr -> fun (_, str) -> fun acc ->
acc ^ "\n " ^ chr ^ " (" ^ str ^ ")")
!units_map ""
in
Misc.fail ("Unknown units `" ^ units_str ^ "' used in `" ^
amount ^ "'\n" ^ context ^ ".\n\nKnown units are:" ^
names ^ "\n\nIf you want to use `" ^
units_str ^ "' units, edit the " ^
"config/units file.")
end
with Not_found -> (1.0, ""), true
end in
let sum_1 = int_of_string (Str.matched_group 3 amount) in
let sum_2 = int_of_string (Str.matched_group 4 amount) in
let sum = (sum_1*100 + sum_2) * (if negative then -1 else 1) in
let str = (Misc.format_money sum) ^ " " ^ name in
if factor = 1.0 then
Sumofmoney.create sum (if default then "" else str)
else
let amount = truncate (factor *. (float sum)) in
Sumofmoney.create amount (if default then "" else str)
else
Misc.fail ("Malformed sum of money `" ^ amount ^ "'\n" ^ context ^ ".\n" ^
"Examples of well-formed sums of money:\n " ^
"3.40 E2.34 -E34.63 (where E is a unit character).")
misery-0.2/src/sumofmoney.ml 0000644 0001750 0001750 00000001660 10754123012 015617 0 ustar wookey wookey type amount = int * string
type default_units_amount = int
let create sum str = (sum, str)
let to_string (amount, str) =
if str <> "" then (Misc.format_money amount) ^ " (" ^ str ^ ")"
else Misc.format_money amount
let zero = (0, "0.00")
let zero_default = 0
let is_negative (sum, _) = sum < 0
let add (sum, str) sum' = sum + sum'
let negate (sum, str) =
if str = "" then (-sum, str)
else
begin
if sum < 0 then
(-sum, String.sub str 1 (String.length str - 1))
else
(-sum, "-" ^ str)
end
let to_string_default = Misc.format_money
let non_negative_default sum = (not (sum <= -1))
let very_negative_default sum = sum < -5000
let negate_default sum = -sum
let scale_default numerator denominator sum =
truncate (numerator /. denominator *. (float sum))
let abs_default a = abs a
let add_default a b = a + b
let subtract_default a b = a - b
let default_to_normal sum = (sum, "")
let is_zero (sum, _) = (sum = 0)
misery-0.2/src/meets.mli 0000644 0001750 0001750 00000000033 10754123012 014675 0 ustar wookey wookey val process : unit -> unit
misery-0.2/src/misc.ml 0000644 0001750 0001750 00000002675 10754123012 014360 0 ustar wookey wookey (* Miscellaneous functions. *)
let flag_verbose = ref false
let get_root_directory () =
try
Sys.getenv "ACCOUNTS_ROOT"
with Not_found -> Sys.getcwd ()
let fail msg =
prerr_endline msg;
exit 1
let open_config_file leafname =
let path = (get_root_directory ()) ^ "/config/" ^ leafname in
try
open_in path
with Sys_error msg ->
fail ("Error whilst opening config file " ^ path ^ ":\n " ^ msg)
let open_config_file_fail_ok leafname =
let path = (get_root_directory ()) ^ "/config/" ^ leafname in
try
open_in path
with Sys_error msg -> raise Not_found
let round amount = (float_of_int (truncate (amount *. 100.0))) /. 100.0
let format_money sum =
(* Note: don't use just "sum / 100" to get the minus sign, because
when sum is zero, any minus won't appear. *)
let s = Printf.sprintf "%d.%02d" (abs (sum / 100)) (abs (sum mod 100)) in
if sum < 0 then "-" ^ s else s
let verbose str =
if !flag_verbose then print_endline str
else ()
let iter_files dir f =
let path = (get_root_directory ()) ^ "/" ^ dir in
let dir = Unix.opendir path in
try
while true do
let name = Unix.readdir dir in
if String.get name 0 <> '.' then
begin
verbose ("iter_initial_files: name=" ^ name);
let channel = open_in (path ^ "/" ^ name) in
(f name channel; close_in channel)
end
else ()
done
with End_of_file ->
Unix.closedir dir
misery-0.2/src/variables.mli 0000644 0001750 0001750 00000000072 10754123012 015533 0 ustar wookey wookey val read_variables : in_channel -> (string * string) list
misery-0.2/src/splits.mli 0000644 0001750 0001750 00000000034 10754123012 015077 0 ustar wookey wookey val process : unit -> unit
misery-0.2/src/variables.ml 0000644 0001750 0001750 00000001100 10754123012 015353 0 ustar wookey wookey let header_rexp = Str.regexp "^\\([a-zA-Z_-]*\\)=\\(.*\\)$"
let read_variables channel =
let rec f acc =
try
let pos = pos_in channel in
let line = input_line channel in
if Str.string_match header_rexp line 0 then
begin
let variable = Str.matched_group 1 line in
let value = Str.matched_group 2 line in
Misc.verbose ("...read binding " ^ variable ^ "=" ^ value);
f ((variable, value) :: acc)
end
else
(seek_in channel pos; acc)
with End_of_file -> acc
in
f []
misery-0.2/src/accountdbase.mli 0000644 0001750 0001750 00000001407 10754123012 016221 0 ustar wookey wookey (* Handling of all individual accounts within the current set of accounts. *)
open Account
module AccountsMap : Map.S with type key = string
val add_account : string -> account -> unit
val update_account : string -> account -> unit
val lookup_account : string -> string -> account
val lookup_account_nofail : string -> (account option)
val add_txn : string -> txn -> string -> unit
val add_txn_negated : string -> txn -> string -> unit
val add_global_txn : txn -> unit
val filter_and_fold_accounts :
(account -> bool) -> ('a -> account -> 'a) -> 'a -> 'a
val sum_integer_variable : string -> int
val load_initial_files : unit -> unit
val lookup_creditor : string -> string -> string
val iter : (account -> unit) -> unit
val group : string -> account list AccountsMap.t
misery-0.2/src/account.mli 0000644 0001750 0001750 00000002537 10754123012 015227 0 ustar wookey wookey (* Handling of a single account. *)
type account
type txn = { year : int;
month : int;
day : int;
creditor : string;
amount : Sumofmoney.amount;
description : string;
automatically_added : bool;
do_not_symmetrise : bool;
linked : bool }
val create : string -> string -> (string * string) list -> account
val create_virtual : string -> string -> (string * string) list -> account
val copy : account -> account -> string -> account
val short_name : account -> string
val full_name : account -> string
val is_virtual : account -> bool
val lookup_variable : string -> account -> string
val lookup_integer_variable : string -> account -> int
val lookup_boolean_variable : string -> account -> bool
val add_txn : txn -> account -> account
val add_txn_negated : txn -> account -> account
val iter_txns : (txn -> unit) -> account -> unit
val iter_txns_sorted : (txn -> unit) -> account -> unit
val map_txns : (txn -> txn) -> account -> account
val fold_txns : ('a -> txn -> 'a) -> 'a -> account -> 'a
val total : account -> Sumofmoney.default_units_amount
val create_account_from_channel : string -> in_channel -> account
val number_of_txns : account -> int
val income : account -> Sumofmoney.default_units_amount
val expenditure : account -> Sumofmoney.default_units_amount
misery-0.2/src/printaccount.ml 0000644 0001750 0001750 00000016206 10754123012 016131 0 ustar wookey wookey (* Dumping of account statements to HTML files. *)
open Account
open Unix
let fixme_rexp = Str.regexp "^.*FIXME.*$"
let next_checkpoint = ref (-1, -1, -1)
let txn_total = ref 0
let find_next_checkpoint which_day (year, month, day) =
if which_day = -1 then (year, month, day)
else
begin
if month = 12 then (year + 1, 1, which_day)
else (year, month + 1, which_day)
end
let date_on_or_after (y, m, d) (y', m', d') =
y > y' || (y == y' && (m > m' || (m == m' && d >= d')))
(* Emit HTML for a single transaction. *)
let rec print_transaction channel acct context cur_total checkpoint_day txn =
incr txn_total;
let css_class =
if Str.string_match fixme_rexp txn.description 0 then
"fixme"
else
"entry"
in
let _ =
if !next_checkpoint = (-1, -1, -1)
then next_checkpoint :=
find_next_checkpoint checkpoint_day (txn.year, txn.month, txn.day)
in
let real_name = Accountdbase.lookup_creditor txn.creditor context in
let date_str = Printf.sprintf "%d-%02d-%02d" txn.year txn.month txn.day in
if not (Sumofmoney.is_zero txn.amount) then
begin
let amount_str = Sumofmoney.to_string txn.amount in
while (checkpoint_day != -1 &&
date_on_or_after (txn.year, txn.month, txn.day) !next_checkpoint)
do
let (cp_year, cp_month, cp_day) = !next_checkpoint in
let date_str =
Printf.sprintf "%d-%02d-%02d" cp_year cp_month cp_day
in
output_string channel "
"
end
(* Dump an HTML account statement to an output channel. *)
let dump acct =
next_checkpoint := (-1, -1, -1);
let short_name = Account.short_name acct in
let tm = Unix.localtime (Unix.time ()) in
let now = Printf.sprintf "%02d:%02d on %d-%02d-%02d"
tm.tm_hour tm.tm_min (tm.tm_year + 1900) (tm.tm_mon+1) tm.tm_mday
in
try
let page_name = "bill-" ^ short_name in
let full_name = Account.full_name acct in
let html_channel = Htmlout.create_page page_name full_name in
let cur_total = ref Sumofmoney.zero_default in
let checkpoint_day =
begin try
Account.lookup_integer_variable "checkpoint_before_day" acct
with Not_found -> -1
end
in
let context = "whilst generating HTML page for " ^ full_name in
output_string html_channel "
Account short name: ";
output_string html_channel short_name;
(*
output_string html_channel " Group: ";
output_string html_channel group;*)
output_string html_channel " Number of transactions: ";
output_string html_channel (string_of_int (Account.number_of_txns acct));
(if not (Account.is_virtual acct) then
begin
output_string html_channel "
Negative amounts indicate that ";
output_string html_channel full_name;
output_string html_channel " is indebted to a creditor." end);
output_string html_channel "
\n";
output_string html_channel "
\n";
output_string html_channel "
Date (YYYY-MM-DD)
";
(if not (Account.is_virtual acct) then
output_string html_channel "
Creditor/Debtor
");
output_string html_channel "
Amount
";
output_string html_channel "
Description
";
output_string html_channel "
";
Account.iter_txns_sorted (print_transaction html_channel acct context
cur_total checkpoint_day)
acct;
let total = Account.total acct in
let total_str = Sumofmoney.to_string_default total in
let income_str = Sumofmoney.to_string_default (Account.income acct) in
let expenditure_str =
Sumofmoney.to_string_default (Account.expenditure acct)
in
output_string html_channel "
![](\"smiley.png\")
");
(if txn.automatically_added && txn.do_not_symmetrise then
output_string channel " ![](\"padlock.png\")
");
(if (not txn.automatically_added) && txn.do_not_symmetrise then
output_string channel " ![](\"exclamation.png\")
");
output_string channel "