summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--bin/dune2
-rw-r--r--bin/main.ml107
-rw-r--r--dune-project2
-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
-rwxr-xr-xmkswitch.sh4
-rw-r--r--rdcapsis.opam8
13 files changed, 656 insertions, 126 deletions
diff --git a/bin/dune b/bin/dune
index 34c3866..64e7c56 100644
--- a/bin/dune
+++ b/bin/dune
@@ -3,4 +3,4 @@
3 (name main) 3 (name main)
4 (preprocess 4 (preprocess
5 (pps ppx_jane)) 5 (pps ppx_jane))
6 (libraries rdcapsis)) 6 (libraries rdcapsis imguiml lwd nottui nottui-unix notty notty.unix))
diff --git a/bin/main.ml b/bin/main.ml
index 8b1be23..b3f4ec9 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -1,3 +1,106 @@
1open Nottui
2module W = Nottui_widgets
3
4let f_to_c x = (x -. 32.0) *. 5.0 /. 9.0
5let c_to_f x = (x *. 9.0 /. 5.0) +. 32.0
6let degrees = Lwd.var 0.0
7let farenheit = Lwd.var (nan, ("", 0))
8
9let farenheit_text =
10 Lwd.map2 (Lwd.get degrees) (Lwd.get farenheit) ~f:(fun d (d', f) ->
11 if d = d' then f else (string_of_float (c_to_f d), 0))
12
13let farenheit_edit =
14 W.edit_field farenheit_text
15 ~on_change:(fun ((text, _) as state) ->
16 let d =
17 match float_of_string_opt text with
18 | None -> Lwd.peek degrees
19 | Some d ->
20 let d = f_to_c d in
21 Lwd.set degrees d;
22 d
23 in
24 Lwd.set farenheit (d, state))
25 ~on_submit:ignore
26
27let celsius = Lwd.var (nan, ("", 0))
28
29let celsius_text =
30 Lwd.map2 (Lwd.get degrees) (Lwd.get celsius) ~f:(fun d (d', f) ->
31 if d = d' then f else (string_of_float d, 0))
32
33let celsius_edit =
34 W.edit_field celsius_text
35 ~on_change:(fun ((text, _) as state) ->
36 let d =
37 match float_of_string_opt text with
38 | None -> Lwd.peek degrees
39 | Some d ->
40 Lwd.set degrees d;
41 d
42 in
43 Lwd.set celsius (d, state))
44 ~on_submit:ignore
45
46let root =
47 Lwd_utils.pack Ui.pack_y
48 [
49 Lwd.pure (W.string "Celsius:");
50 celsius_edit;
51 Lwd.pure (W.string "Farenheight:");
52 farenheit_edit;
53 ]
54
55let root =
56 Lwd_utils.pack Ui.pack_y
57 [
58 root;
59 root;
60 root;
61 root;
62 root;
63 root;
64 root;
65 root;
66 root;
67 root;
68 root;
69 root;
70 root;
71 root;
72 root;
73 root;
74 root;
75 root;
76 ]
77
78let root =
79 Lwd_utils.pack Ui.pack_x
80 [
81 root;
82 root;
83 root;
84 root;
85 root;
86 root;
87 root;
88 root;
89 root;
90 root;
91 root;
92 root;
93 root;
94 root;
95 root;
96 root;
97 root;
98 root;
99 ]
100
101let root = W.scrollbox root
102let () = Nottui_unix.run ~tick_period:0.2 root
103
1open Rdcapsis.Prelude 104open Rdcapsis.Prelude
2 105
3let () = 106let () =
@@ -7,9 +110,9 @@ let () =
7 ~f:(Rdcapsis.Ingcsv.read_channel ~ams_tz) 110 ~f:(Rdcapsis.Ingcsv.read_channel ~ams_tz)
8 |> Result.unwrap 111 |> Result.unwrap
9 in 112 in
10 let euc_id = "EUC" in 113 let euc_id = "EUR/C" in
11 let ledger = 114 let ledger =
12 List.map_result ~f:(Rdcapsis.Convert.les_from_current_acc euc_id) prim_txs 115 List.map_result ~f:(Rdcapsis.Convert.les_from_current_acc euc_id) prim_txs
13 |> Result.unwrap |> List.concat 116 |> Result.unwrap |> List.concat |> Rdcapsis.Ledger.make
14 in 117 in
15 print_endline (Sexp.to_string_hum ([%sexp_of: Rdcapsis.Ledger.t] ledger)) 118 print_endline (Sexp.to_string_hum ([%sexp_of: Rdcapsis.Ledger.t] ledger))
diff --git a/dune-project b/dune-project
index 00fe620..ccfa824 100644
--- a/dune-project
+++ b/dune-project
@@ -19,7 +19,7 @@
19 (name rdcapsis) 19 (name rdcapsis)
20 (synopsis "A short synopsis") 20 (synopsis "A short synopsis")
21 (description "A longer description") 21 (description "A longer description")
22 (depends ocaml zarith core dmap delimited_parsing re (utop :dev) (merlin :dev) (ocamlformat :dev)) 22 (depends ocaml bignum bigdecimal core dmap delimited_parsing re lwd nottui nottui-lwt nottui-unix (utop :dev) (merlin :dev) (ocamlformat :dev) (odoc :doc))
23 (tags 23 (tags
24 ("add topics" "to describe" your project))) 24 ("add topics" "to describe" your project)))
25 25
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]
diff --git a/mkswitch.sh b/mkswitch.sh
new file mode 100755
index 0000000..5f53bb6
--- /dev/null
+++ b/mkswitch.sh
@@ -0,0 +1,4 @@
1#!/bin/bash
2
3opam update --all
4opam switch create ./ --repositories default --deps-only
diff --git a/rdcapsis.opam b/rdcapsis.opam
index 876bf93..5a8adb0 100644
--- a/rdcapsis.opam
+++ b/rdcapsis.opam
@@ -12,14 +12,20 @@ bug-reports: "https://github.com/username/reponame/issues"
12depends: [ 12depends: [
13 "dune" {>= "3.17"} 13 "dune" {>= "3.17"}
14 "ocaml" 14 "ocaml"
15 "zarith" 15 "bignum"
16 "bigdecimal"
16 "core" 17 "core"
17 "dmap" 18 "dmap"
18 "delimited_parsing" 19 "delimited_parsing"
19 "re" 20 "re"
21 "lwd"
22 "nottui"
23 "nottui-lwt"
24 "nottui-unix"
20 "utop" {dev} 25 "utop" {dev}
21 "merlin" {dev} 26 "merlin" {dev}
22 "ocamlformat" {dev} 27 "ocamlformat" {dev}
28 "odoc" {doc}
23 "odoc" {with-doc} 29 "odoc" {with-doc}
24] 30]
25build: [ 31build: [
generated by cgit v1.2.3 (git 2.49.0) at 2025-12-24 21:07:10 +0000