From 46169ec3eb38e177cafd7faf6338d36c6a9e3971 Mon Sep 17 00:00:00 2001
From: Rutger Broekhoff
Date: Thu, 27 Nov 2025 23:35:08 +0100
Subject: Whatever all of this is

---
 lib/convert.ml   |  90 ++++++++---------------
 lib/dune         |   9 ++-
 lib/iban.ml      |  11 ++-
 lib/iban.mli     |   2 +-
 lib/ingcsv.ml    |   5 +-
 lib/ledger.ml    | 192 ++++++++++++++++++++++++++++++++++--------------
 lib/ledger.mli   | 133 ++++++++++++++++++++++++++++++++++
 lib/preledger.ml | 217 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 8 files changed, 538 insertions(+), 121 deletions(-)
 create mode 100644 lib/ledger.mli
 create mode 100644 lib/preledger.ml

(limited to 'lib')

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
 let cents n = Amount (Money.of_z n)
 
 let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) =
+  let make_tx_entries ~on_checking =
+    Account_id_map.of_alist_exn
+      [
+        ( virt_checking_acc,
+          ( on_checking,
+            cents base.amount,
+            Some (Money.of_z base.resulting_balance) ) );
+        ( virt_counterparty,
+          (Debit_credit.opposite on_checking, cents base.amount, None) );
+      ]
+  and base_labels = Labels.singleton (Iban_label Account_tag) base.account in
+
   if Z.(lt base.amount ~$0) then Error Nonpositive_amount
   else
     Result.map_error ~f:(fun e -> Other e)
@@ -19,14 +31,10 @@ let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) =
     match spec with
     | Payment_terminal_payment details ->
         Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id
-          ~credit:
-            (Account_id_map.singleton virt_checking_acc @@ cents base.amount)
-          ~debit:
-            (Account_id_map.singleton virt_counterparty @@ cents base.amount)
+          ~entries:(make_tx_entries ~on_checking:Debit_credit.Credit)
           ~labels:
             Labels.(
-              empty
-              |> add (Iban_label Account_tag) base.account
+              base_labels
               |> add (String_label Counterparty_name_tag)
                    details.counterparty_name
               |> 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)) =
               else Fn.id)
     | Payment_terminal_cashback details ->
         Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id
-          ~debit:
-            (Account_id_map.singleton virt_checking_acc @@ cents base.amount)
-          ~credit:
-            (Account_id_map.singleton virt_counterparty @@ cents base.amount)
+          ~entries:(make_tx_entries ~on_checking:Debit_credit.Debit)
           ~labels:
             Labels.(
-              empty
-              |> add (Iban_label Account_tag) base.account
+              base_labels
               |> add (String_label Counterparty_name_tag)
                    details.counterparty_name
               |> 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)) =
               |> add Timestamp_label details.timestamp)
     | Online_banking_credit details ->
         Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id
-          ~debit:
-            (Account_id_map.singleton virt_checking_acc @@ cents base.amount)
-          ~credit:
-            (Account_id_map.singleton virt_counterparty @@ cents base.amount)
+          ~entries:(make_tx_entries ~on_checking:Debit_credit.Debit)
           ~labels:
             Labels.(
-              empty
-              |> add (Iban_label Account_tag) base.account
+              base_labels
               |> add (String_label Counterparty_name_tag)
                    details.counterparty_name
               |> add (Iban_label Counterparty_iban_tag)
@@ -70,14 +70,10 @@ let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) =
               |> add Timestamp_label details.timestamp)
     | Online_banking_debit details ->
         Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id
-          ~debit:
-            (Account_id_map.singleton virt_counterparty @@ cents base.amount)
-          ~credit:
-            (Account_id_map.singleton virt_checking_acc @@ cents base.amount)
+          ~entries:(make_tx_entries ~on_checking:Debit_credit.Credit)
           ~labels:
             Labels.(
-              empty
-              |> add (Iban_label Account_tag) base.account
+              base_labels
               |> add (String_label Counterparty_name_tag)
                    details.counterparty_name
               |> add (Iban_label Counterparty_iban_tag)
@@ -85,14 +81,10 @@ let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) =
               |> add (String_label Desc_tag) details.description)
     | Recurrent_direct_debit details ->
         Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id
-          ~debit:
-            (Account_id_map.singleton virt_counterparty @@ cents base.amount)
-          ~credit:
-            (Account_id_map.singleton virt_checking_acc @@ cents base.amount)
+          ~entries:(make_tx_entries ~on_checking:Debit_credit.Credit)
           ~labels:
             Labels.(
-              empty
-              |> add (Iban_label Account_tag) base.account
+              base_labels
               |> add (Iban_label Counterparty_iban_tag)
                    details.counterparty_iban
               |> add (String_label Counterparty_name_tag)
@@ -108,24 +100,18 @@ let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) =
                   add (String_label Other_party_tag) other_party)
     | Rounding_savings_deposit details ->
         Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id
-          ~debit:
-            (Account_id_map.singleton virt_counterparty @@ cents base.amount)
-          ~credit:
-            (Account_id_map.singleton virt_checking_acc @@ cents base.amount)
+          ~entries:(make_tx_entries ~on_checking:Debit_credit.Credit)
           ~labels:
             Labels.(
-              empty
+              base_labels
               |> add (Unit_label Auto_round_savings_tag) ()
               |> add (String_label Savings_account_tag) details.savings_account)
     | Deposit details ->
         Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id
-          ~debit:
-            (Account_id_map.singleton virt_checking_acc @@ cents base.amount)
-          ~credit:
-            (Account_id_map.singleton virt_counterparty @@ cents base.amount)
+          ~entries:(make_tx_entries ~on_checking:Debit_credit.Debit)
           ~labels:
             Labels.(
-              empty
+              base_labels
               |> add (Iban_label Counterparty_iban_tag)
                    details.counterparty_iban
               |> add (String_label Counterparty_name_tag)
@@ -134,13 +120,10 @@ let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) =
               |> add (String_label Reference_tag) details.reference)
     | Ideal_debit details ->
         Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id
-          ~debit:
-            (Account_id_map.singleton virt_counterparty @@ cents base.amount)
-          ~credit:
-            (Account_id_map.singleton virt_checking_acc @@ cents base.amount)
+          ~entries:(make_tx_entries ~on_checking:Debit_credit.Credit)
           ~labels:
             Labels.(
-              empty
+              base_labels
               |> add (Iban_label Counterparty_iban_tag)
                    details.counterparty_iban
               |> add (String_label Counterparty_name_tag)
@@ -150,13 +133,10 @@ let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) =
               |> add Timestamp_label details.timestamp)
     | Batch_payment details ->
         Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id
-          ~debit:
-            (Account_id_map.singleton virt_counterparty @@ cents base.amount)
-          ~credit:
-            (Account_id_map.singleton virt_checking_acc @@ cents base.amount)
+          ~entries:(make_tx_entries ~on_checking:Debit_credit.Debit)
           ~labels:
             Labels.(
-              empty
+              base_labels
               |> add (Iban_label Counterparty_iban_tag)
                    details.counterparty_iban
               |> add (String_label Counterparty_name_tag)
@@ -164,14 +144,6 @@ let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) =
               |> add (String_label Desc_tag) details.description
               |> add (String_label Reference_tag) details.reference)
 
-let ba_from_current_acc (Ingcsv.Tx (base, _)) =
-  {
-    account = virt_checking_acc;
-    amount = Money.of_z base.resulting_balance;
-    labels = Labels.(empty |> add (Iban_label Account_tag) base.account);
-  }
-
 let les_from_current_acc euc_id tx =
   let%map tx' = tx_from_current_acc euc_id tx in
-  let ba = ba_from_current_acc tx in
-  [ Bal_assert_item ba; Tx_item tx' ]
+  [ 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 @@
  (name rdcapsis)
  (preprocess
   (pps ppx_jane))
- (libraries core zarith dmap delimited_parsing re core_unix.date_unix))
+ (libraries
+  core
+  bignum.bigint
+  bigdecimal
+  dmap
+  delimited_parsing
+  re
+  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
 let of_string s =
   match make s with
   | Some iban -> iban
-  | None -> Printf.failwithf "Iban.of_string: %S" s ()
+  | None -> Printf.failwithf "Iban.of_string: invalid IBAN %S" s ()
 
 let sexp_of_t iban = Sexp.Atom iban
+
+let t_of_sexp sexp =
+  match sexp with
+  | Sexp.Atom s -> (
+      match make s with
+      | Some iban -> iban
+      | None -> of_sexp_error "Iban.t_of_sexp: invalid IBAN" sexp)
+  | Sexp.List _ -> of_sexp_error "Iban.t_of_sexp: expected a list" sexp
+
 let 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
 type t
 
 val make : string -> t option
-val sexp_of_t : t -> Sexp.t
 
 include Stringable.S with type t := t
 include Equal.S with type t := t
+include 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 @@
 open Prelude
 open Result.Let_syntax
-
-module Debit_credit = struct
-  type t = Debit | Credit [@@deriving string, sexp_of]
-end
+module Debit_credit = Ledger.Debit_credit
 
 module Cents = struct
   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 @@
 open Prelude
 
-type account_type = Asset | Equity | Liability | Expense | Income
-
 type tx_type =
   | Interest_tx
   | Online_banking_tx
@@ -14,11 +12,10 @@ type tx_type =
   | Direct_debit_tx
   | Periodic_tx
 
-type iban_tag = Account_tag | Counterparty_iban_tag
-[@@deriving compare, sexp_of]
+type iban_tag = Account_tag | Counterparty_iban_tag [@@deriving compare, sexp]
 
 type unit_tag = Filed_tag | Google_pay_tag | Auto_round_savings_tag
-[@@deriving compare, sexp_of]
+[@@deriving compare, sexp]
 
 type string_tag =
   | Desc_tag
@@ -32,7 +29,7 @@ type string_tag =
   | Terminal_tag
   | Card_seq_no_tag
   | Savings_account_tag
-[@@deriving compare, sexp_of]
+[@@deriving compare, sexp]
 
 module Label = struct
   type 'a t =
@@ -62,29 +59,41 @@ end
 module Labels = struct
   include Dmap.Make (Label)
 
-  let sexp_of_t m =
-    Sexp.List
-      (bindings m
-      |> List.map ~f:(function
-           | Binding (Iban_label tag, iban) ->
-               Sexp.List
-                 [
-                   Sexp.Atom "Iban_label";
-                   [%sexp_of: iban_tag] tag;
-                   [%sexp_of: Iban.t] iban;
-                 ]
-           | Binding (String_label tag, s) ->
-               Sexp.List
-                 [
-                   Sexp.Atom "String_label";
-                   [%sexp_of: string_tag] tag;
-                   Sexp.Atom s;
-                 ]
-           | Binding (Timestamp_label, ts) ->
-               Sexp.List
-                 [ Sexp.Atom "Timestamp_label"; [%sexp_of: Time_ns_unix.t] ts ]
-           | Binding (Unit_label tag, ()) ->
-               Sexp.List [ Sexp.Atom "Unit_label"; [%sexp_of: unit_tag] tag ]))
+  let sexp_of_binding = function
+    | Binding (Iban_label tag, iban) ->
+        Sexp.List
+          [
+            Sexp.Atom "iban"; [%sexp_of: iban_tag] tag; [%sexp_of: Iban.t] iban;
+          ]
+    | Binding (String_label tag, s) ->
+        Sexp.List
+          [ Sexp.Atom "string"; [%sexp_of: string_tag] tag; Sexp.Atom s ]
+    | Binding (Timestamp_label, ts) ->
+        Sexp.List [ Sexp.Atom "timestamp"; [%sexp_of: Time_ns_unix.t] ts ]
+    | Binding (Unit_label tag, ()) ->
+        Sexp.List [ Sexp.Atom "unit"; [%sexp_of: unit_tag] tag ]
+
+  let binding_of_sexp sexp =
+    match sexp with
+    | Sexp.List [ Sexp.Atom "iban"; tag_sexp; iban_sexp ] ->
+        Binding
+          ( Iban_label ([%of_sexp: iban_tag] tag_sexp),
+            [%of_sexp: Iban.t] iban_sexp )
+    | Sexp.List [ Sexp.Atom "string"; tag_sexp; Sexp.Atom s ] ->
+        Binding (String_label ([%of_sexp: string_tag] tag_sexp), s)
+    | Sexp.List [ Sexp.Atom "timestamp"; ts_sexp ] ->
+        Binding (Timestamp_label, [%of_sexp: Time_ns_unix.t] ts_sexp)
+    | Sexp.List [ Sexp.Atom "unit"; tag_sexp ] ->
+        Binding (Unit_label ([%of_sexp: unit_tag] tag_sexp), ())
+    | _ -> of_sexp_error "Labels.binding_of_sexp: invalid binding" sexp
+
+  let sexp_of_t m = Sexp.List (bindings m |> List.map ~f:sexp_of_binding)
+
+  let t_of_sexp sexp =
+    match sexp with
+    | Sexp.List labels ->
+        Sequence.(of_list labels >>| binding_of_sexp |> to_seq) |> of_seq
+    | Sexp.Atom _ -> of_sexp_error "Labels.t_of_sexp: list needed" sexp
 end
 
 module Money : sig
@@ -92,27 +101,33 @@ module Money : sig
 
   val equal : t -> t -> bool
   val compare : t -> t -> int
-  val of_z : Z.t -> t
-  val to_z : t -> Z.t
+  val of_bigint : Bigint.t -> t
+  val to_bigint : t -> Bigint.t
   val ( + ) : t -> t -> t
   val ( - ) : t -> t -> t
+  val ( = ) : t -> t -> bool
+  val ( ~$ ) : int -> t
   val sexp_of_t : t -> Sexp.t
 end = struct
-  type t = Z.t [@@deriving sexp_of]
-
-  let equal = Z.equal
-  let compare = Z.compare
-  let of_z = Fn.id
-  let to_z = Fn.id
-  let ( + ) x y = Z.(x + y)
-  let ( - ) x y = Z.(x - y)
-end
+  type t = Bigint.t [@@deriving sexp_of]
 
-type scalar = Amount of Money.t | Rate of Z.t
-[@@deriving equal, compare, sexp_of]
+  let equal = Bigint.equal
+  let compare = Bigint.compare
+  let of_bigint = Fn.id
+  let to_bigint = Fn.id
+  let ( + ) x y = Bigint.(x + y)
+  let ( - ) x y = Bigint.(x - y)
+  let ( = ) = equal
+  let ( ~$ ) = Fn.compose of_bigint Bigint.of_int
+end
 
 type commodity_id = string
-(* TODO: consider making this UUID *) [@@deriving sexp]
+(* TODO: consider making this UUID *) [@@deriving equal, compare, sexp]
+
+type scalar =
+  | Amount of Money.t
+  | Rate of { in_primary_commodity : Money.t; rate : Bigdecimal.t }
+[@@deriving equal, compare, sexp_of]
 
 module Account_id = struct
   type t = string list [@@deriving sexp, compare]
@@ -135,13 +150,18 @@ type bal_assert = {
 
 module Account_id_map = Map.Make (Account_id)
 
+module Debit_credit = struct
+  type t = Debit | Credit [@@deriving string, sexp_of]
+
+  let opposite = function Debit -> Credit | Credit -> Debit
+end
+
 module Tx : sig
   (* Private because we only want to allow constructing balanced transactions. *)
   type t = private {
     cleared : Date.t option;
     commodity_id : commodity_id;
-    debit : scalar Account_id_map.t;
-    credit : scalar Account_id_map.t;
+    entries : (Debit_credit.t * scalar * Money.t option) Account_id_map.t;
     labels : Labels.t;
   }
 
@@ -150,8 +170,7 @@ module Tx : sig
   val make :
     cleared:Date.t option ->
     commodity_id:commodity_id ->
-    debit:scalar Account_id_map.t ->
-    credit:scalar Account_id_map.t ->
+    entries:(Debit_credit.t * scalar * Money.t option) Account_id_map.t ->
     labels:Labels.t ->
     (t, error) result
 
@@ -160,23 +179,86 @@ end = struct
   type t = {
     cleared : Date.t option;
     commodity_id : commodity_id;
-    debit : scalar Account_id_map.t;
-    credit : scalar Account_id_map.t;
+    entries : (Debit_credit.t * scalar * Money.t option) Account_id_map.t;
     labels : Labels.t;
   }
   [@@deriving sexp_of]
 
   type error = Unbalanced
 
-  (* TODO: check if debits and credits are balanced *)
-  let is_balanced _debits _credits = true
+  let is_balanced entries =
+    Map.fold entries
+      ~init:Money.(~$0, ~$0)
+      ~f:(fun ~key:_ ~data:(type_, scalar, _oassert) (ds, cs) ->
+        let m =
+          match scalar with
+          | Amount m -> m
+          | Rate { in_primary_commodity = m; _ } -> m
+        in
+        match type_ with
+        | Debit_credit.Debit -> Money.(ds + m, cs)
+        | Debit_credit.Credit -> Money.(ds, cs + m))
+    |> fun (ds, cs) -> Money.(ds = cs)
 
-  let make ~cleared ~commodity_id ~debit ~credit ~labels =
-    if not (is_balanced debit credit) then Error Unbalanced
-    else Ok { cleared; commodity_id; debit; credit; labels }
+  let make ~cleared ~commodity_id ~entries ~labels =
+    if not (is_balanced entries) then Error Unbalanced
+    else Ok { cleared; commodity_id; entries; labels }
 end
 
-type item = Tx_item of Tx.t | Bal_assert_item of bal_assert
+type item =
+  | Tx_item of Tx.t
+  | Bal_assert_item of bal_assert (*| Account_decl_item of account_decl*)
 [@@deriving sexp_of]
 
 type t = item list [@@deriving sexp_of]
+
+module Account = struct
+  type global_type = Asset | Equity | Liability | Expense | Income
+  [@@deriving compare, sexp]
+
+  type asset
+  type global
+
+  type 'a subcategory =
+    | Asset : asset subcategory option -> global subcategory
+    | Checking : asset subcategory
+
+  type 'a t = Sub of ('a, 'a t) category String.Map.t
+
+  let world : global t =
+    Sub
+      (String.Map.of_alist_exn [ ("Assets", Asset (Some (
+           String.Map.of_alist_exn [
+             ("Checking", Checking)
+           ]
+         ))) ])
+end
+
+(*
+module World = struct
+  type t = (commodity_id * Money.t) Account_id_map.t
+
+  let empty : t = Account_id_map.empty
+
+  let apply_tx_entry_base aid primary_commodity debit_credit scalar =
+    let amount = Scalar.to_amount ~commodity:primary_commodity scalar in
+    Map.update aid ~f:(function
+          | None -> 
+
+            (*
+  let assert_bal aid sc world =
+
+  let apply_tx_entry aid (dc, sc, oassert) world = *)
+
+  let apply_tx (tx : Tx.t) world =
+    Map.fold tx.entries ~init:world ~f:(fun ~key:account_id ~data:(type_, scalar, _oassert) world ->
+        
+
+      )
+
+  let apply : item -> t -> t = function
+    | Tx_item tx -> apply_tx tx
+    | Bal_assert_item ba -> apply_ba ba
+end *)
+
+let 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 @@
+open Prelude
+
+(*
+type account_type = Asset | Equity | Liability | Expense | Income
+[@@deriving compare, sexp]*)
+
+type tx_type =
+  | Interest_tx
+  | Online_banking_tx
+  | Recurrent_direct_tx
+  | Payment_terminal_tx
+  | Cash_payment_tx
+  | Atm_tx
+  | Auto_save_rounding_tx
+  | Batch_tx
+  | Direct_debit_tx
+  | Periodic_tx
+
+type iban_tag = Account_tag | Counterparty_iban_tag [@@deriving compare, sexp]
+
+type unit_tag = Filed_tag | Google_pay_tag | Auto_round_savings_tag
+[@@deriving compare, sexp]
+
+type string_tag =
+  | Desc_tag
+  | User_tag
+  | Counterparty_name_tag
+  | Reference_tag
+  | Mandate_id_tag
+  | Creditor_id_tag
+  | Other_party_tag
+  | Transaction_tag
+  | Terminal_tag
+  | Card_seq_no_tag
+  | Savings_account_tag
+[@@deriving compare, sexp]
+
+module Label : sig
+  type 'a t =
+    | Iban_label : iban_tag -> Iban.t t
+    | String_label : string_tag -> string t
+    | Timestamp_label : Time_ns.t t
+    | Unit_label : unit_tag -> unit t
+
+  val int_to_cmp : int -> ('a, 'a) Dmap.cmp
+  val compare : 'a1 'a2. 'a1 t -> 'a2 t -> ('a1, 'a2) Dmap.cmp
+end
+
+module Labels : sig
+  include Dmap.S with type 'a key = 'a Label.t
+
+  val sexp_of_binding : binding -> Sexp.t
+  val binding_of_sexp : Sexp.t -> binding
+
+  include Sexpable.S with type t := t
+end
+
+module Money : sig
+  type t
+
+  val equal : t -> t -> bool
+  val compare : t -> t -> int
+  val of_bigint : Bigint.t -> t
+  val to_bigint : t -> Bigint.t
+  val ( + ) : t -> t -> t
+  val ( - ) : t -> t -> t
+  val ( = ) : t -> t -> bool
+  val ( ~$ ) : int -> t
+  val sexp_of_t : t -> Sexp.t
+end
+
+type commodity_id = string
+(* TODO: consider making this UUID *) [@@deriving equal, compare, sexp]
+
+type scalar =
+  | Amount of Money.t
+  | Rate of { in_primary_commodity : Money.t; rate : Bigdecimal.t }
+[@@deriving equal, compare, sexp_of]
+
+module Account_id : sig
+  type t = string list [@@deriving sexp, compare]
+end
+
+type account = {
+  id : Account_id.t;
+  description : string list;
+  commodity_id : commodity_id;
+  balance : Money.t;
+}
+[@@deriving sexp_of]
+
+type bal_assert = {
+  account : Account_id.t;
+  amount : Money.t;
+  labels : Labels.t;
+}
+[@@deriving sexp_of]
+
+module Account_id_map : Map.S with type Key.t = Account_id.t
+
+module Debit_credit : sig
+  type t = Debit | Credit [@@deriving string, sexp_of]
+
+  val opposite : t -> t
+end
+
+module Tx : sig
+  (* Private because we only want to allow constructing balanced transactions. *)
+  type t = private {
+    cleared : Date.t option;
+    commodity_id : commodity_id;
+    entries : (Debit_credit.t * scalar * Money.t option) Account_id_map.t;
+    labels : Labels.t;
+  }
+
+  type error = Unbalanced
+
+  val make :
+    cleared:Date.t option ->
+    commodity_id:commodity_id ->
+    entries:(Debit_credit.t * scalar * Money.t option) Account_id_map.t ->
+    labels:Labels.t ->
+    (t, error) result
+
+  val sexp_of_t : t -> Sexp.t
+end
+
+type item = Tx_item of Tx.t | Bal_assert_item of bal_assert
+[@@deriving sexp_of]
+
+type t [@@deriving sexp_of]
+
+val 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 @@
+open Prelude
+module Debit_credit = Ledger.Debit_credit
+
+type tx_type =
+  | Interest_tx
+  | Online_banking_tx
+  | Recurrent_direct_tx
+  | Payment_terminal_tx
+  | Cash_payment_tx
+  | Atm_tx
+  | Auto_save_rounding_tx
+  | Batch_tx
+  | Direct_debit_tx
+  | Periodic_tx
+[@@deriving compare, sexp]
+
+type iban_tag = Account_tag | Counterparty_iban_tag [@@deriving compare, sexp]
+
+type unit_tag = Filed_tag | Google_pay_tag | Auto_round_savings_tag
+[@@deriving compare, sexp]
+
+type string_tag =
+  | Desc_tag
+  | User_tag
+  | Counterparty_name_tag
+  | Reference_tag
+  | Mandate_id_tag
+  | Creditor_id_tag
+  | Other_party_tag
+  | Transaction_tag
+  | Terminal_tag
+  | Card_seq_no_tag
+  | Savings_account_tag
+[@@deriving compare, sexp]
+
+module Label = struct
+  type 'a t =
+    | Iban_label : iban_tag -> Iban.t t
+    | String_label : string_tag -> string t
+    | Timestamp_label : Time_ns.t t
+    | Tx_type_label : tx_type t
+    | Unit_label : unit_tag -> unit t
+
+  let int_to_cmp x : ('a, 'a) Dmap.cmp =
+    if x < 0 then Lt else if x > 0 then Gt else Eq
+
+  let compare (type a1 a2) (v1 : a1 t) (v2 : a2 t) : (a1, a2) Dmap.cmp =
+    match (v1, v2) with
+    | Iban_label t1, Iban_label t2 -> int_to_cmp @@ [%compare: iban_tag] t1 t2
+    | String_label t1, String_label t2 ->
+        int_to_cmp @@ [%compare: string_tag] t1 t2
+    | Timestamp_label, Timestamp_label -> Eq
+    | Tx_type_label, Tx_type_label -> Eq
+    | Unit_label t1, Unit_label t2 -> int_to_cmp @@ [%compare: unit_tag] t1 t2
+    | Iban_label _, _ -> Lt
+    | String_label _, Iban_label _ -> Gt
+    | String_label _, _ -> Lt
+    | Timestamp_label, Unit_label _ -> Lt
+    | Timestamp_label, Tx_type_label -> Lt
+    | Timestamp_label, _ -> Gt
+    | Tx_type_label, Unit_label _ -> Lt
+    | Tx_type_label, _ -> Gt
+    | Unit_label _, _ -> Gt
+end
+
+module Labels = struct
+  include Dmap.Make (Label)
+
+  let sexp_of_binding = function
+    | Binding (Iban_label tag, iban) ->
+        Sexp.List
+          [
+            Sexp.Atom "iban"; [%sexp_of: iban_tag] tag; [%sexp_of: Iban.t] iban;
+          ]
+    | Binding (String_label tag, s) ->
+        Sexp.List
+          [ Sexp.Atom "string"; [%sexp_of: string_tag] tag; Sexp.Atom s ]
+    | Binding (Timestamp_label, ts) ->
+        Sexp.List [ Sexp.Atom "timestamp"; [%sexp_of: Time_ns_unix.t] ts ]
+    | Binding (Tx_type_label, type_) ->
+        Sexp.List [ Sexp.Atom "tx_type"; [%sexp_of: tx_type] type_ ]
+    | Binding (Unit_label tag, ()) ->
+        Sexp.List [ Sexp.Atom "unit"; [%sexp_of: unit_tag] tag ]
+
+  let binding_of_sexp sexp =
+    match sexp with
+    | Sexp.List [ Sexp.Atom "iban"; tag_sexp; iban_sexp ] ->
+        Binding
+          ( Iban_label ([%of_sexp: iban_tag] tag_sexp),
+            [%of_sexp: Iban.t] iban_sexp )
+    | Sexp.List [ Sexp.Atom "string"; tag_sexp; Sexp.Atom s ] ->
+        Binding (String_label ([%of_sexp: string_tag] tag_sexp), s)
+    | Sexp.List [ Sexp.Atom "timestamp"; ts_sexp ] ->
+        Binding (Timestamp_label, [%of_sexp: Time_ns_unix.t] ts_sexp)
+    | Sexp.List [ Sexp.Atom "tx_type"; type_sexp ] ->
+        Binding (Tx_type_label, [%of_sexp: tx_type] type_sexp)
+    | Sexp.List [ Sexp.Atom "unit"; tag_sexp ] ->
+        Binding (Unit_label ([%of_sexp: unit_tag] tag_sexp), ())
+    | _ -> of_sexp_error "Labels.binding_of_sexp: invalid binding" sexp
+
+  let sexp_of_t m = Sexp.List (bindings m |> List.map ~f:sexp_of_binding)
+
+  let t_of_sexp sexp =
+    match sexp with
+    | Sexp.List labels ->
+        Sequence.(of_list labels >>| binding_of_sexp |> to_seq) |> of_seq
+    | Sexp.Atom _ -> of_sexp_error "Labels.t_of_sexp: list needed" sexp
+end
+
+module Money : sig
+  type t
+
+  val equal : t -> t -> bool
+  val compare : t -> t -> int
+  val of_z : Z.t -> t
+  val to_z : t -> Z.t
+  val ( + ) : t -> t -> t
+  val ( - ) : t -> t -> t
+  val ( = ) : t -> t -> bool
+  val ( ~$ ) : int -> t
+  val sexp_of_t : t -> Sexp.t
+end = struct
+  type t = Z.t [@@deriving sexp_of]
+
+  let equal = Z.equal
+  let compare = Z.compare
+  let of_z = Fn.id
+  let to_z = Fn.id
+  let ( + ) x y = Z.(x + y)
+  let ( - ) x y = Z.(x - y)
+  let ( = ) = equal
+  let ( ~$ ) = Fn.compose of_z Z.of_int
+end
+
+(* TODO: make rate a decimal *)
+type scalar =
+  | Amount of Money.t
+  | Rate of { in_primary_commodity : Money.t; rate : Z.t }
+[@@deriving equal, compare, sexp_of]
+
+type commodity_id = string
+(* TODO: consider making this UUID *) [@@deriving sexp]
+
+module Account_id = struct
+  type t = string list [@@deriving sexp, compare]
+end
+
+type account = {
+  id : Account_id.t;
+  description : string list;
+  commodity_id : commodity_id;
+  balance : Money.t;
+}
+[@@deriving sexp_of]
+
+type bal_assert = {
+  account : Account_id.t;
+  amount : Money.t;
+  labels : Labels.t;
+}
+[@@deriving sexp_of]
+
+module Account_id_map = Map.Make (Account_id)
+
+module Tx : sig
+  (* Private because we only want to allow constructing balanced transactions. *)
+  type t = private {
+    cleared : Date.t option;
+    commodity_id : commodity_id;
+    entries : (Debit_credit.t * scalar * Money.t option) Account_id_map.t;
+    labels : Labels.t;
+  }
+
+  type error = Unbalanced
+
+  val make :
+    cleared:Date.t option ->
+    commodity_id:commodity_id ->
+    entries:(Debit_credit.t * scalar * Money.t option) Account_id_map.t ->
+    labels:Labels.t ->
+    (t, error) result
+
+  val sexp_of_t : t -> Sexp.t
+end = struct
+  type t = {
+    cleared : Date.t option;
+    commodity_id : commodity_id;
+    entries : (Debit_credit.t * scalar * Money.t option) Account_id_map.t;
+    labels : Labels.t;
+  }
+  [@@deriving sexp_of]
+
+  type error = Unbalanced
+
+  let is_balanced entries =
+    Map.fold entries
+      ~init:Money.(~$0, ~$0)
+      ~f:(fun ~key:_ ~data:(type_, scalar, _oassert) (ds, cs) ->
+        let m =
+          match scalar with
+          | Amount m -> m
+          | Rate { in_primary_commodity = m; _ } -> m
+        in
+        match type_ with
+        | Debit_credit.Debit -> Money.(ds + m, cs)
+        | Debit_credit.Credit -> Money.(ds, cs + m))
+    |> fun (ds, cs) -> Money.(ds = cs)
+
+  let make ~cleared ~commodity_id ~entries ~labels =
+    if not (is_balanced entries) then Error Unbalanced
+    else Ok { cleared; commodity_id; entries; labels }
+end
+
+type item = Tx_item of Tx.t | Bal_assert_item of bal_assert
+[@@deriving sexp_of]
+
+type t = item list [@@deriving sexp_of]
-- 
cgit v1.2.3