File: account.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 (231 lines) | stat: -rw-r--r-- 8,615 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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
(* 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