summaryrefslogtreecommitdiffstats
path: root/lib/ledger.ml
diff options
context:
space:
mode:
authorRutger Broekhoff2025-08-26 00:35:27 +0200
committerRutger Broekhoff2025-08-26 00:35:27 +0200
commite6873458facadea0dfb228bb33291d6baf68c427 (patch)
tree9ca19e2bbb12d92447f654a92280a6048383ebba /lib/ledger.ml
parentb8fbaa53b912347b3b50cac3e913a142db460b0a (diff)
downloadrdcapsis-e6873458facadea0dfb228bb33291d6baf68c427.tar.gz
rdcapsis-e6873458facadea0dfb228bb33291d6baf68c427.zip
Basic import seems to be working
Diffstat (limited to 'lib/ledger.ml')
-rw-r--r--lib/ledger.ml60
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
17type iban_tag = Account_tag | Counterparty_iban_tag [@@deriving compare] 17type iban_tag = Account_tag | Counterparty_iban_tag
18[@@deriving compare, sexp_of]
18 19
19type unit_tag = Filed_tag | Google_pay_tag | Auto_round_savings_tag 20type unit_tag = Filed_tag | Google_pay_tag | Auto_round_savings_tag
20[@@deriving compare] 21[@@deriving compare, sexp_of]
21 22
22type string_tag = 23type 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
36module Label = struct 37module 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
59end 60end
60 61
61module Labels = Dmap.Make (Label) 62module 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 ]))
88end
89
90module Z = struct
91 include Z
92
93 let sexp_of_t x = Sexp.Atom (Z.to_string x)
94end
62 95
63module Money : sig 96module 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
72end = struct 106end = 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)
81end 115end
82 116
83type scalar = Amount of Money.t | Rate of Z.t [@@deriving equal, compare] 117type scalar = Amount of Money.t | Rate of Z.t
84type commodity_id = string (* TODO: consider making this UUID *) 118[@@deriving equal, compare, sexp_of]
119
120type commodity_id = string
121(* TODO: consider making this UUID *) [@@deriving sexp]
85 122
86module Account_id = struct 123module 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
97type bal_assert = { 135type 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
103module Account_id_map = Map.Make (Account_id) 142module 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
122end = struct 162end = 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
141end 181end
142 182
143type item = Tx_item of Tx.t | Bal_assert_item of bal_assert 183type item = Tx_item of Tx.t | Bal_assert_item of bal_assert
144type ledger = Ledger of item list 184[@@deriving sexp_of]
185
186type t = item list [@@deriving sexp_of]