summaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/convert.ml90
-rw-r--r--lib/dune9
-rw-r--r--lib/iban.ml11
-rw-r--r--lib/iban.mli2
-rw-r--r--lib/ingcsv.ml5
-rw-r--r--lib/ledger.ml192
-rw-r--r--lib/ledger.mli133
-rw-r--r--lib/preledger.ml217
8 files changed, 538 insertions, 121 deletions
diff --git a/lib/convert.ml b/lib/convert.ml
index 5afc95e..5411fcc 100644
--- a/lib/convert.ml
+++ b/lib/convert.ml
@@ -12,6 +12,18 @@ type convert_err = Nonpositive_amount | Other of Tx.error
12let cents n = Amount (Money.of_z n) 12let cents n = Amount (Money.of_z n)
13 13
14let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) = 14let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) =
15 let make_tx_entries ~on_checking =
16 Account_id_map.of_alist_exn
17 [
18 ( virt_checking_acc,
19 ( on_checking,
20 cents base.amount,
21 Some (Money.of_z base.resulting_balance) ) );
22 ( virt_counterparty,
23 (Debit_credit.opposite on_checking, cents base.amount, None) );
24 ]
25 and base_labels = Labels.singleton (Iban_label Account_tag) base.account in
26
15 if Z.(lt base.amount ~$0) then Error Nonpositive_amount 27 if Z.(lt base.amount ~$0) then Error Nonpositive_amount
16 else 28 else
17 Result.map_error ~f:(fun e -> Other e) 29 Result.map_error ~f:(fun e -> Other e)
@@ -19,14 +31,10 @@ let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) =
19 match spec with 31 match spec with
20 | Payment_terminal_payment details -> 32 | Payment_terminal_payment details ->
21 Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id 33 Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id
22 ~credit: 34 ~entries:(make_tx_entries ~on_checking:Debit_credit.Credit)
23 (Account_id_map.singleton virt_checking_acc @@ cents base.amount)
24 ~debit:
25 (Account_id_map.singleton virt_counterparty @@ cents base.amount)
26 ~labels: 35 ~labels:
27 Labels.( 36 Labels.(
28 empty 37 base_labels
29 |> add (Iban_label Account_tag) base.account
30 |> add (String_label Counterparty_name_tag) 38 |> add (String_label Counterparty_name_tag)
31 details.counterparty_name 39 details.counterparty_name
32 |> add (String_label Card_seq_no_tag) details.card_sequence_no 40 |> add (String_label Card_seq_no_tag) details.card_sequence_no
@@ -38,14 +46,10 @@ let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) =
38 else Fn.id) 46 else Fn.id)
39 | Payment_terminal_cashback details -> 47 | Payment_terminal_cashback details ->
40 Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id 48 Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id
41 ~debit: 49 ~entries:(make_tx_entries ~on_checking:Debit_credit.Debit)
42 (Account_id_map.singleton virt_checking_acc @@ cents base.amount)
43 ~credit:
44 (Account_id_map.singleton virt_counterparty @@ cents base.amount)
45 ~labels: 50 ~labels:
46 Labels.( 51 Labels.(
47 empty 52 base_labels
48 |> add (Iban_label Account_tag) base.account
49 |> add (String_label Counterparty_name_tag) 53 |> add (String_label Counterparty_name_tag)
50 details.counterparty_name 54 details.counterparty_name
51 |> add (String_label Card_seq_no_tag) details.card_sequence_no 55 |> add (String_label Card_seq_no_tag) details.card_sequence_no
@@ -54,14 +58,10 @@ let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) =
54 |> add Timestamp_label details.timestamp) 58 |> add Timestamp_label details.timestamp)
55 | Online_banking_credit details -> 59 | Online_banking_credit details ->
56 Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id 60 Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id
57 ~debit: 61 ~entries:(make_tx_entries ~on_checking:Debit_credit.Debit)
58 (Account_id_map.singleton virt_checking_acc @@ cents base.amount)
59 ~credit:
60 (Account_id_map.singleton virt_counterparty @@ cents base.amount)
61 ~labels: 62 ~labels:
62 Labels.( 63 Labels.(
63 empty 64 base_labels
64 |> add (Iban_label Account_tag) base.account
65 |> add (String_label Counterparty_name_tag) 65 |> add (String_label Counterparty_name_tag)
66 details.counterparty_name 66 details.counterparty_name
67 |> add (Iban_label Counterparty_iban_tag) 67 |> add (Iban_label Counterparty_iban_tag)
@@ -70,14 +70,10 @@ let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) =
70 |> add Timestamp_label details.timestamp) 70 |> add Timestamp_label details.timestamp)
71 | Online_banking_debit details -> 71 | Online_banking_debit details ->
72 Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id 72 Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id
73 ~debit: 73 ~entries:(make_tx_entries ~on_checking:Debit_credit.Credit)
74 (Account_id_map.singleton virt_counterparty @@ cents base.amount)
75 ~credit:
76 (Account_id_map.singleton virt_checking_acc @@ cents base.amount)
77 ~labels: 74 ~labels:
78 Labels.( 75 Labels.(
79 empty 76 base_labels
80 |> add (Iban_label Account_tag) base.account
81 |> add (String_label Counterparty_name_tag) 77 |> add (String_label Counterparty_name_tag)
82 details.counterparty_name 78 details.counterparty_name
83 |> add (Iban_label Counterparty_iban_tag) 79 |> add (Iban_label Counterparty_iban_tag)
@@ -85,14 +81,10 @@ let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) =
85 |> add (String_label Desc_tag) details.description) 81 |> add (String_label Desc_tag) details.description)
86 | Recurrent_direct_debit details -> 82 | Recurrent_direct_debit details ->
87 Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id 83 Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id
88 ~debit: 84 ~entries:(make_tx_entries ~on_checking:Debit_credit.Credit)
89 (Account_id_map.singleton virt_counterparty @@ cents base.amount)
90 ~credit:
91 (Account_id_map.singleton virt_checking_acc @@ cents base.amount)
92 ~labels: 85 ~labels:
93 Labels.( 86 Labels.(
94 empty 87 base_labels
95 |> add (Iban_label Account_tag) base.account
96 |> add (Iban_label Counterparty_iban_tag) 88 |> add (Iban_label Counterparty_iban_tag)
97 details.counterparty_iban 89 details.counterparty_iban
98 |> add (String_label Counterparty_name_tag) 90 |> add (String_label Counterparty_name_tag)
@@ -108,24 +100,18 @@ let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) =
108 add (String_label Other_party_tag) other_party) 100 add (String_label Other_party_tag) other_party)
109 | Rounding_savings_deposit details -> 101 | Rounding_savings_deposit details ->
110 Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id 102 Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id
111 ~debit: 103 ~entries:(make_tx_entries ~on_checking:Debit_credit.Credit)
112 (Account_id_map.singleton virt_counterparty @@ cents base.amount)
113 ~credit:
114 (Account_id_map.singleton virt_checking_acc @@ cents base.amount)
115 ~labels: 104 ~labels:
116 Labels.( 105 Labels.(
117 empty 106 base_labels
118 |> add (Unit_label Auto_round_savings_tag) () 107 |> add (Unit_label Auto_round_savings_tag) ()
119 |> add (String_label Savings_account_tag) details.savings_account) 108 |> add (String_label Savings_account_tag) details.savings_account)
120 | Deposit details -> 109 | Deposit details ->
121 Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id 110 Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id
122 ~debit: 111 ~entries:(make_tx_entries ~on_checking:Debit_credit.Debit)
123 (Account_id_map.singleton virt_checking_acc @@ cents base.amount)
124 ~credit:
125 (Account_id_map.singleton virt_counterparty @@ cents base.amount)
126 ~labels: 112 ~labels:
127 Labels.( 113 Labels.(
128 empty 114 base_labels
129 |> add (Iban_label Counterparty_iban_tag) 115 |> add (Iban_label Counterparty_iban_tag)
130 details.counterparty_iban 116 details.counterparty_iban
131 |> add (String_label Counterparty_name_tag) 117 |> add (String_label Counterparty_name_tag)
@@ -134,13 +120,10 @@ let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) =
134 |> add (String_label Reference_tag) details.reference) 120 |> add (String_label Reference_tag) details.reference)
135 | Ideal_debit details -> 121 | Ideal_debit details ->
136 Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id 122 Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id
137 ~debit: 123 ~entries:(make_tx_entries ~on_checking:Debit_credit.Credit)
138 (Account_id_map.singleton virt_counterparty @@ cents base.amount)
139 ~credit:
140 (Account_id_map.singleton virt_checking_acc @@ cents base.amount)
141 ~labels: 124 ~labels:
142 Labels.( 125 Labels.(
143 empty 126 base_labels
144 |> add (Iban_label Counterparty_iban_tag) 127 |> add (Iban_label Counterparty_iban_tag)
145 details.counterparty_iban 128 details.counterparty_iban
146 |> add (String_label Counterparty_name_tag) 129 |> add (String_label Counterparty_name_tag)
@@ -150,13 +133,10 @@ let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) =
150 |> add Timestamp_label details.timestamp) 133 |> add Timestamp_label details.timestamp)
151 | Batch_payment details -> 134 | Batch_payment details ->
152 Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id 135 Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id
153 ~debit: 136 ~entries:(make_tx_entries ~on_checking:Debit_credit.Debit)
154 (Account_id_map.singleton virt_counterparty @@ cents base.amount)
155 ~credit:
156 (Account_id_map.singleton virt_checking_acc @@ cents base.amount)
157 ~labels: 137 ~labels:
158 Labels.( 138 Labels.(
159 empty 139 base_labels
160 |> add (Iban_label Counterparty_iban_tag) 140 |> add (Iban_label Counterparty_iban_tag)
161 details.counterparty_iban 141 details.counterparty_iban
162 |> add (String_label Counterparty_name_tag) 142 |> add (String_label Counterparty_name_tag)
@@ -164,14 +144,6 @@ let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) =
164 |> add (String_label Desc_tag) details.description 144 |> add (String_label Desc_tag) details.description
165 |> add (String_label Reference_tag) details.reference) 145 |> add (String_label Reference_tag) details.reference)
166 146
167let ba_from_current_acc (Ingcsv.Tx (base, _)) =
168 {
169 account = virt_checking_acc;
170 amount = Money.of_z base.resulting_balance;
171 labels = Labels.(empty |> add (Iban_label Account_tag) base.account);
172 }
173
174let les_from_current_acc euc_id tx = 147let les_from_current_acc euc_id tx =
175 let%map tx' = tx_from_current_acc euc_id tx in 148 let%map tx' = tx_from_current_acc euc_id tx in
176 let ba = ba_from_current_acc tx in 149 [ Tx_item tx' ]
177 [ Bal_assert_item ba; Tx_item tx' ]
diff --git a/lib/dune b/lib/dune
index ff9a2ee..6208dd7 100644
--- a/lib/dune
+++ b/lib/dune
@@ -2,4 +2,11 @@
2 (name rdcapsis) 2 (name rdcapsis)
3 (preprocess 3 (preprocess
4 (pps ppx_jane)) 4 (pps ppx_jane))
5 (libraries core zarith dmap delimited_parsing re core_unix.date_unix)) 5 (libraries
6 core
7 bignum.bigint
8 bigdecimal
9 dmap
10 delimited_parsing
11 re
12 core_unix.date_unix))
diff --git a/lib/iban.ml b/lib/iban.ml
index fbea774..9b516c4 100644
--- a/lib/iban.ml
+++ b/lib/iban.ml
@@ -82,7 +82,16 @@ let to_string = Fn.id
82let of_string s = 82let of_string s =
83 match make s with 83 match make s with
84 | Some iban -> iban 84 | Some iban -> iban
85 | None -> Printf.failwithf "Iban.of_string: %S" s () 85 | None -> Printf.failwithf "Iban.of_string: invalid IBAN %S" s ()
86 86
87let sexp_of_t iban = Sexp.Atom iban 87let sexp_of_t iban = Sexp.Atom iban
88
89let t_of_sexp sexp =
90 match sexp with
91 | Sexp.Atom s -> (
92 match make s with
93 | Some iban -> iban
94 | None -> of_sexp_error "Iban.t_of_sexp: invalid IBAN" sexp)
95 | Sexp.List _ -> of_sexp_error "Iban.t_of_sexp: expected a list" sexp
96
88let equal = String.equal 97let equal = String.equal
diff --git a/lib/iban.mli b/lib/iban.mli
index fa18a63..3a5698a 100644
--- a/lib/iban.mli
+++ b/lib/iban.mli
@@ -3,7 +3,7 @@ open Prelude
3type t 3type t
4 4
5val make : string -> t option 5val make : string -> t option
6val sexp_of_t : t -> Sexp.t
7 6
8include Stringable.S with type t := t 7include Stringable.S with type t := t
9include Equal.S with type t := t 8include Equal.S with type t := t
9include Sexpable.S with type t := t
diff --git a/lib/ingcsv.ml b/lib/ingcsv.ml
index f9cd95e..bef9ab9 100644
--- a/lib/ingcsv.ml
+++ b/lib/ingcsv.ml
@@ -1,9 +1,6 @@
1open Prelude 1open Prelude
2open Result.Let_syntax 2open Result.Let_syntax
3 3module Debit_credit = Ledger.Debit_credit
4module Debit_credit = struct
5 type t = Debit | Credit [@@deriving string, sexp_of]
6end
7 4
8module Cents = struct 5module Cents = struct
9 type t = Z.t 6 type t = Z.t
diff --git a/lib/ledger.ml b/lib/ledger.ml
index 84a0146..7805179 100644
--- a/lib/ledger.ml
+++ b/lib/ledger.ml
@@ -1,7 +1,5 @@
1open Prelude 1open Prelude
2 2
3type account_type = Asset | Equity | Liability | Expense | Income
4
5type tx_type = 3type tx_type =
6 | Interest_tx 4 | Interest_tx
7 | Online_banking_tx 5 | Online_banking_tx
@@ -14,11 +12,10 @@ type tx_type =
14 | Direct_debit_tx 12 | Direct_debit_tx
15 | Periodic_tx 13 | Periodic_tx
16 14
17type iban_tag = Account_tag | Counterparty_iban_tag 15type iban_tag = Account_tag | Counterparty_iban_tag [@@deriving compare, sexp]
18[@@deriving compare, sexp_of]
19 16
20type unit_tag = Filed_tag | Google_pay_tag | Auto_round_savings_tag 17type unit_tag = Filed_tag | Google_pay_tag | Auto_round_savings_tag
21[@@deriving compare, sexp_of] 18[@@deriving compare, sexp]
22 19
23type string_tag = 20type string_tag =
24 | Desc_tag 21 | Desc_tag
@@ -32,7 +29,7 @@ type string_tag =
32 | Terminal_tag 29 | Terminal_tag
33 | Card_seq_no_tag 30 | Card_seq_no_tag
34 | Savings_account_tag 31 | Savings_account_tag
35[@@deriving compare, sexp_of] 32[@@deriving compare, sexp]
36 33
37module Label = struct 34module Label = struct
38 type 'a t = 35 type 'a t =
@@ -62,29 +59,41 @@ end
62module Labels = struct 59module Labels = struct
63 include Dmap.Make (Label) 60 include Dmap.Make (Label)
64 61
65 let sexp_of_t m = 62 let sexp_of_binding = function
66 Sexp.List 63 | Binding (Iban_label tag, iban) ->
67 (bindings m 64 Sexp.List
68 |> List.map ~f:(function 65 [
69 | Binding (Iban_label tag, iban) -> 66 Sexp.Atom "iban"; [%sexp_of: iban_tag] tag; [%sexp_of: Iban.t] iban;
70 Sexp.List 67 ]
71 [ 68 | Binding (String_label tag, s) ->
72 Sexp.Atom "Iban_label"; 69 Sexp.List
73 [%sexp_of: iban_tag] tag; 70 [ Sexp.Atom "string"; [%sexp_of: string_tag] tag; Sexp.Atom s ]
74 [%sexp_of: Iban.t] iban; 71 | Binding (Timestamp_label, ts) ->
75 ] 72 Sexp.List [ Sexp.Atom "timestamp"; [%sexp_of: Time_ns_unix.t] ts ]
76 | Binding (String_label tag, s) -> 73 | Binding (Unit_label tag, ()) ->
77 Sexp.List 74 Sexp.List [ Sexp.Atom "unit"; [%sexp_of: unit_tag] tag ]
78 [ 75
79 Sexp.Atom "String_label"; 76 let binding_of_sexp sexp =
80 [%sexp_of: string_tag] tag; 77 match sexp with
81 Sexp.Atom s; 78 | Sexp.List [ Sexp.Atom "iban"; tag_sexp; iban_sexp ] ->
82 ] 79 Binding
83 | Binding (Timestamp_label, ts) -> 80 ( Iban_label ([%of_sexp: iban_tag] tag_sexp),
84 Sexp.List 81 [%of_sexp: Iban.t] iban_sexp )
85 [ Sexp.Atom "Timestamp_label"; [%sexp_of: Time_ns_unix.t] ts ] 82 | Sexp.List [ Sexp.Atom "string"; tag_sexp; Sexp.Atom s ] ->
86 | Binding (Unit_label tag, ()) -> 83 Binding (String_label ([%of_sexp: string_tag] tag_sexp), s)
87 Sexp.List [ Sexp.Atom "Unit_label"; [%sexp_of: unit_tag] tag ])) 84 | Sexp.List [ Sexp.Atom "timestamp"; ts_sexp ] ->
85 Binding (Timestamp_label, [%of_sexp: Time_ns_unix.t] ts_sexp)
86 | Sexp.List [ Sexp.Atom "unit"; tag_sexp ] ->
87 Binding (Unit_label ([%of_sexp: unit_tag] tag_sexp), ())
88 | _ -> of_sexp_error "Labels.binding_of_sexp: invalid binding" sexp
89
90 let sexp_of_t m = Sexp.List (bindings m |> List.map ~f:sexp_of_binding)
91
92 let t_of_sexp sexp =
93 match sexp with
94 | Sexp.List labels ->
95 Sequence.(of_list labels >>| binding_of_sexp |> to_seq) |> of_seq
96 | Sexp.Atom _ -> of_sexp_error "Labels.t_of_sexp: list needed" sexp
88end 97end
89 98
90module Money : sig 99module Money : sig
@@ -92,27 +101,33 @@ module Money : sig
92 101
93 val equal : t -> t -> bool 102 val equal : t -> t -> bool
94 val compare : t -> t -> int 103 val compare : t -> t -> int
95 val of_z : Z.t -> t 104 val of_bigint : Bigint.t -> t
96 val to_z : t -> Z.t 105 val to_bigint : t -> Bigint.t
97 val ( + ) : t -> t -> t 106 val ( + ) : t -> t -> t
98 val ( - ) : t -> t -> t 107 val ( - ) : t -> t -> t
108 val ( = ) : t -> t -> bool
109 val ( ~$ ) : int -> t
99 val sexp_of_t : t -> Sexp.t 110 val sexp_of_t : t -> Sexp.t
100end = struct 111end = struct
101 type t = Z.t [@@deriving sexp_of] 112 type t = Bigint.t [@@deriving sexp_of]
102
103 let equal = Z.equal
104 let compare = Z.compare
105 let of_z = Fn.id
106 let to_z = Fn.id
107 let ( + ) x y = Z.(x + y)
108 let ( - ) x y = Z.(x - y)
109end
110 113
111type scalar = Amount of Money.t | Rate of Z.t 114 let equal = Bigint.equal
112[@@deriving equal, compare, sexp_of] 115 let compare = Bigint.compare
116 let of_bigint = Fn.id
117 let to_bigint = Fn.id
118 let ( + ) x y = Bigint.(x + y)
119 let ( - ) x y = Bigint.(x - y)
120 let ( = ) = equal
121 let ( ~$ ) = Fn.compose of_bigint Bigint.of_int
122end
113 123
114type commodity_id = string 124type commodity_id = string
115(* TODO: consider making this UUID *) [@@deriving sexp] 125(* TODO: consider making this UUID *) [@@deriving equal, compare, sexp]
126
127type scalar =
128 | Amount of Money.t
129 | Rate of { in_primary_commodity : Money.t; rate : Bigdecimal.t }
130[@@deriving equal, compare, sexp_of]
116 131
117module Account_id = struct 132module Account_id = struct
118 type t = string list [@@deriving sexp, compare] 133 type t = string list [@@deriving sexp, compare]
@@ -135,13 +150,18 @@ type bal_assert = {
135 150
136module Account_id_map = Map.Make (Account_id) 151module Account_id_map = Map.Make (Account_id)
137 152
153module Debit_credit = struct
154 type t = Debit | Credit [@@deriving string, sexp_of]
155
156 let opposite = function Debit -> Credit | Credit -> Debit
157end
158
138module Tx : sig 159module Tx : sig
139 (* Private because we only want to allow constructing balanced transactions. *) 160 (* Private because we only want to allow constructing balanced transactions. *)
140 type t = private { 161 type t = private {
141 cleared : Date.t option; 162 cleared : Date.t option;
142 commodity_id : commodity_id; 163 commodity_id : commodity_id;
143 debit : scalar Account_id_map.t; 164 entries : (Debit_credit.t * scalar * Money.t option) Account_id_map.t;
144 credit : scalar Account_id_map.t;
145 labels : Labels.t; 165 labels : Labels.t;
146 } 166 }
147 167
@@ -150,8 +170,7 @@ module Tx : sig
150 val make : 170 val make :
151 cleared:Date.t option -> 171 cleared:Date.t option ->
152 commodity_id:commodity_id -> 172 commodity_id:commodity_id ->
153 debit:scalar Account_id_map.t -> 173 entries:(Debit_credit.t * scalar * Money.t option) Account_id_map.t ->
154 credit:scalar Account_id_map.t ->
155 labels:Labels.t -> 174 labels:Labels.t ->
156 (t, error) result 175 (t, error) result
157 176
@@ -160,23 +179,86 @@ end = struct
160 type t = { 179 type t = {
161 cleared : Date.t option; 180 cleared : Date.t option;
162 commodity_id : commodity_id; 181 commodity_id : commodity_id;
163 debit : scalar Account_id_map.t; 182 entries : (Debit_credit.t * scalar * Money.t option) Account_id_map.t;
164 credit : scalar Account_id_map.t;
165 labels : Labels.t; 183 labels : Labels.t;
166 } 184 }
167 [@@deriving sexp_of] 185 [@@deriving sexp_of]
168 186
169 type error = Unbalanced 187 type error = Unbalanced
170 188
171 (* TODO: check if debits and credits are balanced *) 189 let is_balanced entries =
172 let is_balanced _debits _credits = true 190 Map.fold entries
191 ~init:Money.(~$0, ~$0)
192 ~f:(fun ~key:_ ~data:(type_, scalar, _oassert) (ds, cs) ->
193 let m =
194 match scalar with
195 | Amount m -> m
196 | Rate { in_primary_commodity = m; _ } -> m
197 in
198 match type_ with
199 | Debit_credit.Debit -> Money.(ds + m, cs)
200 | Debit_credit.Credit -> Money.(ds, cs + m))
201 |> fun (ds, cs) -> Money.(ds = cs)
173 202
174 let make ~cleared ~commodity_id ~debit ~credit ~labels = 203 let make ~cleared ~commodity_id ~entries ~labels =
175 if not (is_balanced debit credit) then Error Unbalanced 204 if not (is_balanced entries) then Error Unbalanced
176 else Ok { cleared; commodity_id; debit; credit; labels } 205 else Ok { cleared; commodity_id; entries; labels }
177end 206end
178 207
179type item = Tx_item of Tx.t | Bal_assert_item of bal_assert 208type item =
209 | Tx_item of Tx.t
210 | Bal_assert_item of bal_assert (*| Account_decl_item of account_decl*)
180[@@deriving sexp_of] 211[@@deriving sexp_of]
181 212
182type t = item list [@@deriving sexp_of] 213type t = item list [@@deriving sexp_of]
214
215module Account = struct
216 type global_type = Asset | Equity | Liability | Expense | Income
217 [@@deriving compare, sexp]
218
219 type asset
220 type global
221
222 type 'a subcategory =
223 | Asset : asset subcategory option -> global subcategory
224 | Checking : asset subcategory
225
226 type 'a t = Sub of ('a, 'a t) category String.Map.t
227
228 let world : global t =
229 Sub
230 (String.Map.of_alist_exn [ ("Assets", Asset (Some (
231 String.Map.of_alist_exn [
232 ("Checking", Checking)
233 ]
234 ))) ])
235end
236
237(*
238module World = struct
239 type t = (commodity_id * Money.t) Account_id_map.t
240
241 let empty : t = Account_id_map.empty
242
243 let apply_tx_entry_base aid primary_commodity debit_credit scalar =
244 let amount = Scalar.to_amount ~commodity:primary_commodity scalar in
245 Map.update aid ~f:(function
246 | None ->
247
248 (*
249 let assert_bal aid sc world =
250
251 let apply_tx_entry aid (dc, sc, oassert) world = *)
252
253 let apply_tx (tx : Tx.t) world =
254 Map.fold tx.entries ~init:world ~f:(fun ~key:account_id ~data:(type_, scalar, _oassert) world ->
255
256
257 )
258
259 let apply : item -> t -> t = function
260 | Tx_item tx -> apply_tx tx
261 | Bal_assert_item ba -> apply_ba ba
262end *)
263
264let make = Fn.id
diff --git a/lib/ledger.mli b/lib/ledger.mli
new file mode 100644
index 0000000..0b8e383
--- /dev/null
+++ b/lib/ledger.mli
@@ -0,0 +1,133 @@
1open Prelude
2
3(*
4type account_type = Asset | Equity | Liability | Expense | Income
5[@@deriving compare, sexp]*)
6
7type tx_type =
8 | Interest_tx
9 | Online_banking_tx
10 | Recurrent_direct_tx
11 | Payment_terminal_tx
12 | Cash_payment_tx
13 | Atm_tx
14 | Auto_save_rounding_tx
15 | Batch_tx
16 | Direct_debit_tx
17 | Periodic_tx
18
19type iban_tag = Account_tag | Counterparty_iban_tag [@@deriving compare, sexp]
20
21type unit_tag = Filed_tag | Google_pay_tag | Auto_round_savings_tag
22[@@deriving compare, sexp]
23
24type string_tag =
25 | Desc_tag
26 | User_tag
27 | Counterparty_name_tag
28 | Reference_tag
29 | Mandate_id_tag
30 | Creditor_id_tag
31 | Other_party_tag
32 | Transaction_tag
33 | Terminal_tag
34 | Card_seq_no_tag
35 | Savings_account_tag
36[@@deriving compare, sexp]
37
38module Label : sig
39 type 'a t =
40 | Iban_label : iban_tag -> Iban.t t
41 | String_label : string_tag -> string t
42 | Timestamp_label : Time_ns.t t
43 | Unit_label : unit_tag -> unit t
44
45 val int_to_cmp : int -> ('a, 'a) Dmap.cmp
46 val compare : 'a1 'a2. 'a1 t -> 'a2 t -> ('a1, 'a2) Dmap.cmp
47end
48
49module Labels : sig
50 include Dmap.S with type 'a key = 'a Label.t
51
52 val sexp_of_binding : binding -> Sexp.t
53 val binding_of_sexp : Sexp.t -> binding
54
55 include Sexpable.S with type t := t
56end
57
58module Money : sig
59 type t
60
61 val equal : t -> t -> bool
62 val compare : t -> t -> int
63 val of_bigint : Bigint.t -> t
64 val to_bigint : t -> Bigint.t
65 val ( + ) : t -> t -> t
66 val ( - ) : t -> t -> t
67 val ( = ) : t -> t -> bool
68 val ( ~$ ) : int -> t
69 val sexp_of_t : t -> Sexp.t
70end
71
72type commodity_id = string
73(* TODO: consider making this UUID *) [@@deriving equal, compare, sexp]
74
75type scalar =
76 | Amount of Money.t
77 | Rate of { in_primary_commodity : Money.t; rate : Bigdecimal.t }
78[@@deriving equal, compare, sexp_of]
79
80module Account_id : sig
81 type t = string list [@@deriving sexp, compare]
82end
83
84type account = {
85 id : Account_id.t;
86 description : string list;
87 commodity_id : commodity_id;
88 balance : Money.t;
89}
90[@@deriving sexp_of]
91
92type bal_assert = {
93 account : Account_id.t;
94 amount : Money.t;
95 labels : Labels.t;
96}
97[@@deriving sexp_of]
98
99module Account_id_map : Map.S with type Key.t = Account_id.t
100
101module Debit_credit : sig
102 type t = Debit | Credit [@@deriving string, sexp_of]
103
104 val opposite : t -> t
105end
106
107module Tx : sig
108 (* Private because we only want to allow constructing balanced transactions. *)
109 type t = private {
110 cleared : Date.t option;
111 commodity_id : commodity_id;
112 entries : (Debit_credit.t * scalar * Money.t option) Account_id_map.t;
113 labels : Labels.t;
114 }
115
116 type error = Unbalanced
117
118 val make :
119 cleared:Date.t option ->
120 commodity_id:commodity_id ->
121 entries:(Debit_credit.t * scalar * Money.t option) Account_id_map.t ->
122 labels:Labels.t ->
123 (t, error) result
124
125 val sexp_of_t : t -> Sexp.t
126end
127
128type item = Tx_item of Tx.t | Bal_assert_item of bal_assert
129[@@deriving sexp_of]
130
131type t [@@deriving sexp_of]
132
133val make : item list -> t
diff --git a/lib/preledger.ml b/lib/preledger.ml
new file mode 100644
index 0000000..05f9e36
--- /dev/null
+++ b/lib/preledger.ml
@@ -0,0 +1,217 @@
1open Prelude
2module Debit_credit = Ledger.Debit_credit
3
4type tx_type =
5 | Interest_tx
6 | Online_banking_tx
7 | Recurrent_direct_tx
8 | Payment_terminal_tx
9 | Cash_payment_tx
10 | Atm_tx
11 | Auto_save_rounding_tx
12 | Batch_tx
13 | Direct_debit_tx
14 | Periodic_tx
15[@@deriving compare, sexp]
16
17type iban_tag = Account_tag | Counterparty_iban_tag [@@deriving compare, sexp]
18
19type unit_tag = Filed_tag | Google_pay_tag | Auto_round_savings_tag
20[@@deriving compare, sexp]
21
22type string_tag =
23 | Desc_tag
24 | User_tag
25 | Counterparty_name_tag
26 | Reference_tag
27 | Mandate_id_tag
28 | Creditor_id_tag
29 | Other_party_tag
30 | Transaction_tag
31 | Terminal_tag
32 | Card_seq_no_tag
33 | Savings_account_tag
34[@@deriving compare, sexp]
35
36module Label = struct
37 type 'a t =
38 | Iban_label : iban_tag -> Iban.t t
39 | String_label : string_tag -> string t
40 | Timestamp_label : Time_ns.t t
41 | Tx_type_label : tx_type t
42 | Unit_label : unit_tag -> unit t
43
44 let int_to_cmp x : ('a, 'a) Dmap.cmp =
45 if x < 0 then Lt else if x > 0 then Gt else Eq
46
47 let compare (type a1 a2) (v1 : a1 t) (v2 : a2 t) : (a1, a2) Dmap.cmp =
48 match (v1, v2) with
49 | Iban_label t1, Iban_label t2 -> int_to_cmp @@ [%compare: iban_tag] t1 t2
50 | String_label t1, String_label t2 ->
51 int_to_cmp @@ [%compare: string_tag] t1 t2
52 | Timestamp_label, Timestamp_label -> Eq
53 | Tx_type_label, Tx_type_label -> Eq
54 | Unit_label t1, Unit_label t2 -> int_to_cmp @@ [%compare: unit_tag] t1 t2
55 | Iban_label _, _ -> Lt
56 | String_label _, Iban_label _ -> Gt
57 | String_label _, _ -> Lt
58 | Timestamp_label, Unit_label _ -> Lt
59 | Timestamp_label, Tx_type_label -> Lt
60 | Timestamp_label, _ -> Gt
61 | Tx_type_label, Unit_label _ -> Lt
62 | Tx_type_label, _ -> Gt
63 | Unit_label _, _ -> Gt
64end
65
66module Labels = struct
67 include Dmap.Make (Label)
68
69 let sexp_of_binding = function
70 | Binding (Iban_label tag, iban) ->
71 Sexp.List
72 [
73 Sexp.Atom "iban"; [%sexp_of: iban_tag] tag; [%sexp_of: Iban.t] iban;
74 ]
75 | Binding (String_label tag, s) ->
76 Sexp.List
77 [ Sexp.Atom "string"; [%sexp_of: string_tag] tag; Sexp.Atom s ]
78 | Binding (Timestamp_label, ts) ->
79 Sexp.List [ Sexp.Atom "timestamp"; [%sexp_of: Time_ns_unix.t] ts ]
80 | Binding (Tx_type_label, type_) ->
81 Sexp.List [ Sexp.Atom "tx_type"; [%sexp_of: tx_type] type_ ]
82 | Binding (Unit_label tag, ()) ->
83 Sexp.List [ Sexp.Atom "unit"; [%sexp_of: unit_tag] tag ]
84
85 let binding_of_sexp sexp =
86 match sexp with
87 | Sexp.List [ Sexp.Atom "iban"; tag_sexp; iban_sexp ] ->
88 Binding
89 ( Iban_label ([%of_sexp: iban_tag] tag_sexp),
90 [%of_sexp: Iban.t] iban_sexp )
91 | Sexp.List [ Sexp.Atom "string"; tag_sexp; Sexp.Atom s ] ->
92 Binding (String_label ([%of_sexp: string_tag] tag_sexp), s)
93 | Sexp.List [ Sexp.Atom "timestamp"; ts_sexp ] ->
94 Binding (Timestamp_label, [%of_sexp: Time_ns_unix.t] ts_sexp)
95 | Sexp.List [ Sexp.Atom "tx_type"; type_sexp ] ->
96 Binding (Tx_type_label, [%of_sexp: tx_type] type_sexp)
97 | Sexp.List [ Sexp.Atom "unit"; tag_sexp ] ->
98 Binding (Unit_label ([%of_sexp: unit_tag] tag_sexp), ())
99 | _ -> of_sexp_error "Labels.binding_of_sexp: invalid binding" sexp
100
101 let sexp_of_t m = Sexp.List (bindings m |> List.map ~f:sexp_of_binding)
102
103 let t_of_sexp sexp =
104 match sexp with
105 | Sexp.List labels ->
106 Sequence.(of_list labels >>| binding_of_sexp |> to_seq) |> of_seq
107 | Sexp.Atom _ -> of_sexp_error "Labels.t_of_sexp: list needed" sexp
108end
109
110module Money : sig
111 type t
112
113 val equal : t -> t -> bool
114 val compare : t -> t -> int
115 val of_z : Z.t -> t
116 val to_z : t -> Z.t
117 val ( + ) : t -> t -> t
118 val ( - ) : t -> t -> t
119 val ( = ) : t -> t -> bool
120 val ( ~$ ) : int -> t
121 val sexp_of_t : t -> Sexp.t
122end = struct
123 type t = Z.t [@@deriving sexp_of]
124
125 let equal = Z.equal
126 let compare = Z.compare
127 let of_z = Fn.id
128 let to_z = Fn.id
129 let ( + ) x y = Z.(x + y)
130 let ( - ) x y = Z.(x - y)
131 let ( = ) = equal
132 let ( ~$ ) = Fn.compose of_z Z.of_int
133end
134
135(* TODO: make rate a decimal *)
136type scalar =
137 | Amount of Money.t
138 | Rate of { in_primary_commodity : Money.t; rate : Z.t }
139[@@deriving equal, compare, sexp_of]
140
141type commodity_id = string
142(* TODO: consider making this UUID *) [@@deriving sexp]
143
144module Account_id = struct
145 type t = string list [@@deriving sexp, compare]
146end
147
148type account = {
149 id : Account_id.t;
150 description : string list;
151 commodity_id : commodity_id;
152 balance : Money.t;
153}
154[@@deriving sexp_of]
155
156type bal_assert = {
157 account : Account_id.t;
158 amount : Money.t;
159 labels : Labels.t;
160}
161[@@deriving sexp_of]
162
163module Account_id_map = Map.Make (Account_id)
164
165module Tx : sig
166 (* Private because we only want to allow constructing balanced transactions. *)
167 type t = private {
168 cleared : Date.t option;
169 commodity_id : commodity_id;
170 entries : (Debit_credit.t * scalar * Money.t option) Account_id_map.t;
171 labels : Labels.t;
172 }
173
174 type error = Unbalanced
175
176 val make :
177 cleared:Date.t option ->
178 commodity_id:commodity_id ->
179 entries:(Debit_credit.t * scalar * Money.t option) Account_id_map.t ->
180 labels:Labels.t ->
181 (t, error) result
182
183 val sexp_of_t : t -> Sexp.t
184end = struct
185 type t = {
186 cleared : Date.t option;
187 commodity_id : commodity_id;
188 entries : (Debit_credit.t * scalar * Money.t option) Account_id_map.t;
189 labels : Labels.t;
190 }
191 [@@deriving sexp_of]
192
193 type error = Unbalanced
194
195 let is_balanced entries =
196 Map.fold entries
197 ~init:Money.(~$0, ~$0)
198 ~f:(fun ~key:_ ~data:(type_, scalar, _oassert) (ds, cs) ->
199 let m =
200 match scalar with
201 | Amount m -> m
202 | Rate { in_primary_commodity = m; _ } -> m
203 in
204 match type_ with
205 | Debit_credit.Debit -> Money.(ds + m, cs)
206 | Debit_credit.Credit -> Money.(ds, cs + m))
207 |> fun (ds, cs) -> Money.(ds = cs)
208
209 let make ~cleared ~commodity_id ~entries ~labels =
210 if not (is_balanced entries) then Error Unbalanced
211 else Ok { cleared; commodity_id; entries; labels }
212end
213
214type item = Tx_item of Tx.t | Bal_assert_item of bal_assert
215[@@deriving sexp_of]
216
217type t = item list [@@deriving sexp_of]