summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRutger Broekhoff2025-08-26 11:16:29 +0200
committerRutger Broekhoff2025-08-26 11:16:29 +0200
commitf95748e82a354f2ac857359774ec3227705838af (patch)
treee9d8eaf5d8b1cdb3950fdd2929ec5d97e541bf03
parente6873458facadea0dfb228bb33291d6baf68c427 (diff)
downloadrdcapsis-f95748e82a354f2ac857359774ec3227705838af.tar.gz
rdcapsis-f95748e82a354f2ac857359774ec3227705838af.zip
Prelude
-rw-r--r--bin/main.ml25
-rw-r--r--lib/convert.ml2
-rw-r--r--lib/iban.ml4
-rw-r--r--lib/iban.mli2
-rw-r--r--lib/ingcsv.ml18
-rw-r--r--lib/ledger.ml26
-rw-r--r--lib/prelude.ml31
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 @@
1open Core 1open Rdcapsis.Prelude
2module Time_ns = Time_ns_unix 2module Time_ns = Time_ns_unix
3 3
4module 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
17end
18
19module Result = struct
20 include Result
21
22 let unwrap = function
23 | Error _ -> failwith "Result.unwrap: unexpected (Error _)"
24 | Ok v -> v
25end
26
27let () = 4let () =
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 @@
1open Core 1open Prelude
2open Ledger 2open Ledger
3open Result.Let_syntax 3open 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 @@
1open Core 1open Prelude
2open Option.Let_syntax 2open Option.Let_syntax
3 3
4type t = string 4type 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. *)
7module M97 : sig 7module 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 @@
1open Core 1open Prelude
2 2
3type t 3type 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 @@
1open Core 1open Prelude
2open Result.Let_syntax 2open Result.Let_syntax
3module Time_ns = Time_ns_unix
4 3
5module Debit_credit = struct 4module 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
562type csv_err = Parse_err of parse_err_ext | Exn of exn 561type csv_err = Parse_err of parse_err_ext | Exn of exn
563 562
564module 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
577end
578
579let read_channel (c : In_channel.t) ~ams_tz : (tx list, csv_err) result = 563let 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 @@
1open Core 1open Prelude
2 2
3type account_type = Asset | Equity | Liability | Expense | Income 3type 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 ]))
88end 88end
89 89
90module Z = struct
91 include Z
92
93 let sexp_of_t x = Sexp.Atom (Z.to_string x)
94end
95
96module Money : sig 90module Money : sig
97 type t 91 type t
98 92
@@ -142,7 +136,15 @@ type bal_assert = {
142module Account_id_map = Map.Make (Account_id) 136module Account_id_map = Map.Make (Account_id)
143 137
144module Tx : sig 138module 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
162end = struct 159end = 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 @@
1include Core
2module Time_ns = Time_ns_unix
3
4module 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
17end
18
19module Z = struct
20 include Z
21
22 let sexp_of_t x = Sexp.Atom (Z.to_string x)
23end
24
25module Result = struct
26 include Result
27
28 let unwrap = function
29 | Error _ -> failwith "Result.unwrap: unexpected (Error _)"
30 | Ok v -> v
31end