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 /lib | |
| parent | e6873458facadea0dfb228bb33291d6baf68c427 (diff) | |
| download | rdcapsis-f95748e82a354f2ac857359774ec3227705838af.tar.gz rdcapsis-f95748e82a354f2ac857359774ec3227705838af.zip | |
Prelude
Diffstat (limited to 'lib')
| -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 |
6 files changed, 47 insertions, 36 deletions
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 | ||