1 files changed, 217 insertions, 0 deletions

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]