diff options
author | Rutger Broekhoff | 2025-08-26 11:16:29 +0200 |
---|---|---|
committer | Rutger Broekhoff | 2025-08-26 11:16:29 +0200 |
commit | f95748e82a354f2ac857359774ec3227705838af (patch) | |
tree | e9d8eaf5d8b1cdb3950fdd2929ec5d97e541bf03 | |
parent | e6873458facadea0dfb228bb33291d6baf68c427 (diff) | |
download | rdcapsis-f95748e82a354f2ac857359774ec3227705838af.tar.gz rdcapsis-f95748e82a354f2ac857359774ec3227705838af.zip |
Prelude
-rw-r--r-- | bin/main.ml | 25 | ||||
-rw-r--r-- | lib/convert.ml | 2 | ||||
-rw-r--r-- | lib/iban.ml | 4 | ||||
-rw-r--r-- | lib/iban.mli | 2 | ||||
-rw-r--r-- | lib/ingcsv.ml | 18 | ||||
-rw-r--r-- | lib/ledger.ml | 26 | ||||
-rw-r--r-- | lib/prelude.ml | 31 |
7 files changed, 48 insertions, 60 deletions
diff --git a/bin/main.ml b/bin/main.ml index 1c6c6c9..f2986ab 100644 --- a/bin/main.ml +++ b/bin/main.ml | |||
@@ -1,29 +1,6 @@ | |||
1 | open Core | 1 | open Rdcapsis.Prelude |
2 | module Time_ns = Time_ns_unix | 2 | module Time_ns = Time_ns_unix |
3 | 3 | ||
4 | module List = struct | ||
5 | include List | ||
6 | |||
7 | let map_result ~(f : 'a -> ('b, 'c) result) : 'a list -> ('b list, 'c) result | ||
8 | = | ||
9 | let open Result.Let_syntax in | ||
10 | let rec go = function | ||
11 | | [] -> return [] | ||
12 | | x :: xs -> | ||
13 | let%map x' = f x and xs' = go xs in | ||
14 | x' :: xs' | ||
15 | in | ||
16 | go | ||
17 | end | ||
18 | |||
19 | module Result = struct | ||
20 | include Result | ||
21 | |||
22 | let unwrap = function | ||
23 | | Error _ -> failwith "Result.unwrap: unexpected (Error _)" | ||
24 | | Ok v -> v | ||
25 | end | ||
26 | |||
27 | let () = | 4 | let () = |
28 | let ams_tz = Time_ns.Zone.find_exn "Europe/Amsterdam" in | 5 | let ams_tz = Time_ns.Zone.find_exn "Europe/Amsterdam" in |
29 | let prim_txs = | 6 | let prim_txs = |
diff --git a/lib/convert.ml b/lib/convert.ml index fb41020..5afc95e 100644 --- a/lib/convert.ml +++ b/lib/convert.ml | |||
@@ -1,4 +1,4 @@ | |||
1 | open Core | 1 | open Prelude |
2 | open Ledger | 2 | open Ledger |
3 | open Result.Let_syntax | 3 | open Result.Let_syntax |
4 | 4 | ||
diff --git a/lib/iban.ml b/lib/iban.ml index 1db6c7b..fbea774 100644 --- a/lib/iban.ml +++ b/lib/iban.ml | |||
@@ -1,11 +1,11 @@ | |||
1 | open Core | 1 | open Prelude |
2 | open Option.Let_syntax | 2 | open Option.Let_syntax |
3 | 3 | ||
4 | type t = string | 4 | type t = string |
5 | 5 | ||
6 | (* Modulo-97 arithmetic. Prevents us from having to use Zarith here. *) | 6 | (* Modulo-97 arithmetic. Prevents us from having to use Zarith here. *) |
7 | module M97 : sig | 7 | module M97 : sig |
8 | type t | 8 | type t = private int |
9 | 9 | ||
10 | val of_int : int -> t | 10 | val of_int : int -> t |
11 | val lt : t -> t -> bool | 11 | val lt : t -> t -> bool |
diff --git a/lib/iban.mli b/lib/iban.mli index c2cad9f..fa18a63 100644 --- a/lib/iban.mli +++ b/lib/iban.mli | |||
@@ -1,4 +1,4 @@ | |||
1 | open Core | 1 | open Prelude |
2 | 2 | ||
3 | type t | 3 | type t |
4 | 4 | ||
diff --git a/lib/ingcsv.ml b/lib/ingcsv.ml index 53258fe..edb8aaa 100644 --- a/lib/ingcsv.ml +++ b/lib/ingcsv.ml | |||
@@ -1,6 +1,5 @@ | |||
1 | open Core | 1 | open Prelude |
2 | open Result.Let_syntax | 2 | open Result.Let_syntax |
3 | module Time_ns = Time_ns_unix | ||
4 | 3 | ||
5 | module Debit_credit = struct | 4 | module Debit_credit = struct |
6 | type t = Debit | Credit [@@deriving string, sexp_of] | 5 | type t = Debit | Credit [@@deriving string, sexp_of] |
@@ -561,21 +560,6 @@ let tx_from_prim ptx ~ams_tz : (tx, parse_err_ext) result = | |||
561 | 560 | ||
562 | type csv_err = Parse_err of parse_err_ext | Exn of exn | 561 | type csv_err = Parse_err of parse_err_ext | Exn of exn |
563 | 562 | ||
564 | module List = struct | ||
565 | include List | ||
566 | |||
567 | let map_result ~(f : 'a -> ('b, 'c) result) : 'a list -> ('b list, 'c) result | ||
568 | = | ||
569 | let open Result.Let_syntax in | ||
570 | let rec go = function | ||
571 | | [] -> return [] | ||
572 | | x :: xs -> | ||
573 | let%map x' = f x and xs' = go xs in | ||
574 | x' :: xs' | ||
575 | in | ||
576 | go | ||
577 | end | ||
578 | |||
579 | let read_channel (c : In_channel.t) ~ams_tz : (tx list, csv_err) result = | 563 | let read_channel (c : In_channel.t) ~ams_tz : (tx list, csv_err) result = |
580 | let%bind ptxs = | 564 | let%bind ptxs = |
581 | try | 565 | try |
diff --git a/lib/ledger.ml b/lib/ledger.ml index ba21e49..84a0146 100644 --- a/lib/ledger.ml +++ b/lib/ledger.ml | |||
@@ -1,4 +1,4 @@ | |||
1 | open Core | 1 | open Prelude |
2 | 2 | ||
3 | type account_type = Asset | Equity | Liability | Expense | Income | 3 | type account_type = Asset | Equity | Liability | Expense | Income |
4 | 4 | ||
@@ -87,12 +87,6 @@ module Labels = struct | |||
87 | Sexp.List [ Sexp.Atom "Unit_label"; [%sexp_of: unit_tag] tag ])) | 87 | Sexp.List [ Sexp.Atom "Unit_label"; [%sexp_of: unit_tag] tag ])) |
88 | end | 88 | end |
89 | 89 | ||
90 | module Z = struct | ||
91 | include Z | ||
92 | |||
93 | let sexp_of_t x = Sexp.Atom (Z.to_string x) | ||
94 | end | ||
95 | |||
96 | module Money : sig | 90 | module Money : sig |
97 | type t | 91 | type t |
98 | 92 | ||
@@ -142,7 +136,15 @@ type bal_assert = { | |||
142 | module Account_id_map = Map.Make (Account_id) | 136 | module Account_id_map = Map.Make (Account_id) |
143 | 137 | ||
144 | module Tx : sig | 138 | module Tx : sig |
145 | type t | 139 | (* Private because we only want to allow constructing balanced transactions. *) |
140 | type t = private { | ||
141 | cleared : Date.t option; | ||
142 | commodity_id : commodity_id; | ||
143 | debit : scalar Account_id_map.t; | ||
144 | credit : scalar Account_id_map.t; | ||
145 | labels : Labels.t; | ||
146 | } | ||
147 | |||
146 | type error = Unbalanced | 148 | type error = Unbalanced |
147 | 149 | ||
148 | val make : | 150 | val make : |
@@ -153,14 +155,8 @@ module Tx : sig | |||
153 | labels:Labels.t -> | 155 | labels:Labels.t -> |
154 | (t, error) result | 156 | (t, error) result |
155 | 157 | ||
156 | val cleared : t -> Date.t option | ||
157 | val commodity_id : t -> commodity_id | ||
158 | val debit : t -> scalar Account_id_map.t | ||
159 | val credit : t -> scalar Account_id_map.t | ||
160 | val labels : t -> Labels.t | ||
161 | val sexp_of_t : t -> Sexp.t | 158 | val sexp_of_t : t -> Sexp.t |
162 | end = struct | 159 | end = struct |
163 | (* We hide this because we only want to allow constructing balanced transactions *) | ||
164 | type t = { | 160 | type t = { |
165 | cleared : Date.t option; | 161 | cleared : Date.t option; |
166 | commodity_id : commodity_id; | 162 | commodity_id : commodity_id; |
@@ -168,7 +164,7 @@ end = struct | |||
168 | credit : scalar Account_id_map.t; | 164 | credit : scalar Account_id_map.t; |
169 | labels : Labels.t; | 165 | labels : Labels.t; |
170 | } | 166 | } |
171 | [@@deriving fields, sexp_of] | 167 | [@@deriving sexp_of] |
172 | 168 | ||
173 | type error = Unbalanced | 169 | type error = Unbalanced |
174 | 170 | ||
diff --git a/lib/prelude.ml b/lib/prelude.ml new file mode 100644 index 0000000..57f7af3 --- /dev/null +++ b/lib/prelude.ml | |||
@@ -0,0 +1,31 @@ | |||
1 | include Core | ||
2 | module Time_ns = Time_ns_unix | ||
3 | |||
4 | module List = struct | ||
5 | include List | ||
6 | |||
7 | let map_result ~(f : 'a -> ('b, 'c) result) : 'a list -> ('b list, 'c) result | ||
8 | = | ||
9 | let open Result.Let_syntax in | ||
10 | let rec go = function | ||
11 | | [] -> return [] | ||
12 | | x :: xs -> | ||
13 | let%map x' = f x and xs' = go xs in | ||
14 | x' :: xs' | ||
15 | in | ||
16 | go | ||
17 | end | ||
18 | |||
19 | module Z = struct | ||
20 | include Z | ||
21 | |||
22 | let sexp_of_t x = Sexp.Atom (Z.to_string x) | ||
23 | end | ||
24 | |||
25 | module Result = struct | ||
26 | include Result | ||
27 | |||
28 | let unwrap = function | ||
29 | | Error _ -> failwith "Result.unwrap: unexpected (Error _)" | ||
30 | | Ok v -> v | ||
31 | end | ||