diff options
author | Rutger Broekhoff | 2025-08-26 00:35:27 +0200 |
---|---|---|
committer | Rutger Broekhoff | 2025-08-26 00:35:27 +0200 |
commit | e6873458facadea0dfb228bb33291d6baf68c427 (patch) | |
tree | 9ca19e2bbb12d92447f654a92280a6048383ebba /lib/ledger.ml | |
parent | b8fbaa53b912347b3b50cac3e913a142db460b0a (diff) | |
download | rdcapsis-e6873458facadea0dfb228bb33291d6baf68c427.tar.gz rdcapsis-e6873458facadea0dfb228bb33291d6baf68c427.zip |
Basic import seems to be working
Diffstat (limited to 'lib/ledger.ml')
-rw-r--r-- | lib/ledger.ml | 60 |
1 files changed, 51 insertions, 9 deletions
diff --git a/lib/ledger.ml b/lib/ledger.ml index 3b52bcc..ba21e49 100644 --- a/lib/ledger.ml +++ b/lib/ledger.ml | |||
@@ -14,10 +14,11 @@ type tx_type = | |||
14 | | Direct_debit_tx | 14 | | Direct_debit_tx |
15 | | Periodic_tx | 15 | | Periodic_tx |
16 | 16 | ||
17 | type iban_tag = Account_tag | Counterparty_iban_tag [@@deriving compare] | 17 | type iban_tag = Account_tag | Counterparty_iban_tag |
18 | [@@deriving compare, sexp_of] | ||
18 | 19 | ||
19 | type unit_tag = Filed_tag | Google_pay_tag | Auto_round_savings_tag | 20 | type unit_tag = Filed_tag | Google_pay_tag | Auto_round_savings_tag |
20 | [@@deriving compare] | 21 | [@@deriving compare, sexp_of] |
21 | 22 | ||
22 | type string_tag = | 23 | type string_tag = |
23 | | Desc_tag | 24 | | Desc_tag |
@@ -31,7 +32,7 @@ type string_tag = | |||
31 | | Terminal_tag | 32 | | Terminal_tag |
32 | | Card_seq_no_tag | 33 | | Card_seq_no_tag |
33 | | Savings_account_tag | 34 | | Savings_account_tag |
34 | [@@deriving compare] | 35 | [@@deriving compare, sexp_of] |
35 | 36 | ||
36 | module Label = struct | 37 | module Label = struct |
37 | type 'a t = | 38 | type 'a t = |
@@ -58,7 +59,39 @@ module Label = struct | |||
58 | | Unit_label _, _ -> Gt | 59 | | Unit_label _, _ -> Gt |
59 | end | 60 | end |
60 | 61 | ||
61 | module Labels = Dmap.Make (Label) | 62 | module Labels = struct |
63 | include Dmap.Make (Label) | ||
64 | |||
65 | let sexp_of_t m = | ||
66 | Sexp.List | ||
67 | (bindings m | ||
68 | |> List.map ~f:(function | ||
69 | | Binding (Iban_label tag, iban) -> | ||
70 | Sexp.List | ||
71 | [ | ||
72 | Sexp.Atom "Iban_label"; | ||
73 | [%sexp_of: iban_tag] tag; | ||
74 | [%sexp_of: Iban.t] iban; | ||
75 | ] | ||
76 | | Binding (String_label tag, s) -> | ||
77 | Sexp.List | ||
78 | [ | ||
79 | Sexp.Atom "String_label"; | ||
80 | [%sexp_of: string_tag] tag; | ||
81 | Sexp.Atom s; | ||
82 | ] | ||
83 | | Binding (Timestamp_label, ts) -> | ||
84 | Sexp.List | ||
85 | [ Sexp.Atom "Timestamp_label"; [%sexp_of: Time_ns_unix.t] ts ] | ||
86 | | Binding (Unit_label tag, ()) -> | ||
87 | Sexp.List [ Sexp.Atom "Unit_label"; [%sexp_of: unit_tag] tag ])) | ||
88 | end | ||
89 | |||
90 | module Z = struct | ||
91 | include Z | ||
92 | |||
93 | let sexp_of_t x = Sexp.Atom (Z.to_string x) | ||
94 | end | ||
62 | 95 | ||
63 | module Money : sig | 96 | module Money : sig |
64 | type t | 97 | type t |
@@ -69,8 +102,9 @@ module Money : sig | |||
69 | val to_z : t -> Z.t | 102 | val to_z : t -> Z.t |
70 | val ( + ) : t -> t -> t | 103 | val ( + ) : t -> t -> t |
71 | val ( - ) : t -> t -> t | 104 | val ( - ) : t -> t -> t |
105 | val sexp_of_t : t -> Sexp.t | ||
72 | end = struct | 106 | end = struct |
73 | type t = Z.t | 107 | type t = Z.t [@@deriving sexp_of] |
74 | 108 | ||
75 | let equal = Z.equal | 109 | let equal = Z.equal |
76 | let compare = Z.compare | 110 | let compare = Z.compare |
@@ -80,8 +114,11 @@ end = struct | |||
80 | let ( - ) x y = Z.(x - y) | 114 | let ( - ) x y = Z.(x - y) |
81 | end | 115 | end |
82 | 116 | ||
83 | type scalar = Amount of Money.t | Rate of Z.t [@@deriving equal, compare] | 117 | type scalar = Amount of Money.t | Rate of Z.t |
84 | type commodity_id = string (* TODO: consider making this UUID *) | 118 | [@@deriving equal, compare, sexp_of] |
119 | |||
120 | type commodity_id = string | ||
121 | (* TODO: consider making this UUID *) [@@deriving sexp] | ||
85 | 122 | ||
86 | module Account_id = struct | 123 | module Account_id = struct |
87 | type t = string list [@@deriving sexp, compare] | 124 | type t = string list [@@deriving sexp, compare] |
@@ -93,12 +130,14 @@ type account = { | |||
93 | commodity_id : commodity_id; | 130 | commodity_id : commodity_id; |
94 | balance : Money.t; | 131 | balance : Money.t; |
95 | } | 132 | } |
133 | [@@deriving sexp_of] | ||
96 | 134 | ||
97 | type bal_assert = { | 135 | type bal_assert = { |
98 | account : Account_id.t; | 136 | account : Account_id.t; |
99 | amount : Money.t; | 137 | amount : Money.t; |
100 | labels : Labels.t; | 138 | labels : Labels.t; |
101 | } | 139 | } |
140 | [@@deriving sexp_of] | ||
102 | 141 | ||
103 | module Account_id_map = Map.Make (Account_id) | 142 | module Account_id_map = Map.Make (Account_id) |
104 | 143 | ||
@@ -119,6 +158,7 @@ module Tx : sig | |||
119 | val debit : t -> scalar Account_id_map.t | 158 | val debit : t -> scalar Account_id_map.t |
120 | val credit : t -> scalar Account_id_map.t | 159 | val credit : t -> scalar Account_id_map.t |
121 | val labels : t -> Labels.t | 160 | val labels : t -> Labels.t |
161 | val sexp_of_t : t -> Sexp.t | ||
122 | end = struct | 162 | end = struct |
123 | (* We hide this because we only want to allow constructing balanced transactions *) | 163 | (* We hide this because we only want to allow constructing balanced transactions *) |
124 | type t = { | 164 | type t = { |
@@ -128,7 +168,7 @@ end = struct | |||
128 | credit : scalar Account_id_map.t; | 168 | credit : scalar Account_id_map.t; |
129 | labels : Labels.t; | 169 | labels : Labels.t; |
130 | } | 170 | } |
131 | [@@deriving fields] | 171 | [@@deriving fields, sexp_of] |
132 | 172 | ||
133 | type error = Unbalanced | 173 | type error = Unbalanced |
134 | 174 | ||
@@ -141,4 +181,6 @@ end = struct | |||
141 | end | 181 | end |
142 | 182 | ||
143 | type item = Tx_item of Tx.t | Bal_assert_item of bal_assert | 183 | type item = Tx_item of Tx.t | Bal_assert_item of bal_assert |
144 | type ledger = Ledger of item list | 184 | [@@deriving sexp_of] |
185 | |||
186 | type t = item list [@@deriving sexp_of] | ||