1 files changed, 377 insertions, 365 deletions

diff --git a/lib/ledger.ml b/lib/ledger.ml
index 115588a..87f3ead 100644
--- a/lib/ledger.ml
+++ b/lib/ledger.ml
@@ -237,50 +237,34 @@ module Account_structure0 = struct
       end
     end
 
-    module Accounts_payable :
-      S with type outer = Categories.liability and type inner = Categories.final =
-    struct
+    module Accounts_payable = struct
       type outer = Categories.liability
       type inner = Categories.final
 
       module Specialize (F : Scaffold) (G : module type of Make (F)) = struct
-        let cons inner = G.Accounts_payable inner
+        let cons v = G.Accounts_payable v
       end
       end
     end
-  end
-
-module Account_type = struct
-  type 'a elem = Leaf | Node of 'a [@@deriving sexp_of]
-
-  module Scaffold = struct
-    type 'a t = 'a elem [@@deriving sexp_of]
-  end
-
-  include Account_structure0.Make (Scaffold)
-end
-
-module Account_structure (F : Account_structure0.Scaffold) = struct
-  module Structure = Account_structure0.Make (F)
-  include Structure
 
-  module Folder3 (Acc : sig
-    type 'a t
-  end) =
+  module Visitor
+      (F : Scaffold)
+      (G :
+        module type of Make (F))
+          (Acc : sig
+            type 'a t
+          end) =
   struct
     type nonrec 'outer t = {
       car :
         'inner.
-        'inner f F.t ->
-        (module Account_structure0.Gen_f_cons.S
-           with type inner = 'inner
-            and type outer = 'outer) ->
+        'inner G.f F.t ->
+        (module Gen_f_cons.S with type inner = 'inner and type outer = 'outer) ->
         'outer Acc.t;
     }
 
-    let fold (type a) (f : a t) : a f -> a Acc.t = function
-      | Accounts_payable v ->
-          f.car v (module Account_structure0.Gen_f_cons.Accounts_payable)
+    let visit (type a) (f : a t) : a G.f -> a Acc.t = function
+      | G.Accounts_payable v -> f.car v (module Gen_f_cons.Accounts_payable)
       | _ -> failwith "kaas"
     (*
       | Accounts_receivable v ->
@@ -294,221 +278,249 @@ module Account_structure (F : Account_structure0.Scaffold) = struct
       | Checking v -> f.car v (fun inner -> H.Checking inner) *)
   end
 
-  module Folder = struct
-    type nonrec 'b t = { car : 'a. 'a f F.t -> 'b }
-
-    let fold (type b c) (f : c t) : b f -> c =
-      let module Inst = Folder3 (struct
-        type 'a t = c
-      end) in
-      Inst.fold { car = (fun v _cons -> f.car v) }
+  module Basic_visitor (F : Scaffold) (G : module type of Make (F)) = struct
+    type nonrec 'b t = { car : 'a. 'a G.f F.t -> 'b }
+
+    let visit (type b c) (f : c t) : b G.f -> c =
+      let module Inst =
+        Visitor (F) (G)
+          (struct
+            type 'a t = c
+          end)
+      in
+      Inst.visit { car = (fun v _cons -> f.car v) }
+  end
   end
 
-  module Mapper = struct
-    type nonrec 'b t = {
-      car :
-        'a.
-        'a f F.t ->
-        ('a Account_type.f Account_type.elem -> Account_type.t0) ->
-        ('b * 'a f F.t) option;
-    }
+  module Account_type = struct
+    type 'a elem = Leaf | Node of 'a [@@deriving sexp_of]
 
-    let map (type b c) (f : c t) (mkt : b Account_type.f -> Account_type.t0) :
-        b f -> (c * b f) option =
-      let module Inst = Folder3 (struct
-        type 'b t = (c * 'b f) option
-      end) in
-      Inst.fold
-        {
-          car =
-            (fun (type inner)
-              v
-              (module Gen_cons : Account_structure0.Gen_f_cons.S
-                with type inner = inner
-                 and type outer = b)
-            ->
-              let open Option.Let_syntax in
-              let module Type_cons =
-                Gen_cons.Specialize (Account_type.Scaffold) (Account_type)
-              in
-              let module Own_cons = Gen_cons.Specialize (F) (Structure) in
-              let%map c, v' = f.car v (fun el -> mkt (Type_cons.cons el)) in
-              (c, Own_cons.cons v'));
-        }
+    module Scaffold = struct
+      type 'a t = 'a elem [@@deriving sexp_of]
+    end
+
+    include Account_structure0.Make (Scaffold)
   end
-end
 
-module Typed_account_path = struct
-  type 'a elem = Leaf | Node of string * 'a | Ind of string * 'a elem
-  [@@deriving sexp_of]
+  module Account_structure (F : Account_structure0.Scaffold) = struct
+    module Structure = Account_structure0.Make (F)
+    include Structure
+
+    module Mapper = struct
+      type nonrec 'b t = {
+        car :
+          'a.
+          'a f F.t ->
+          ('a Account_type.f Account_type.elem -> Account_type.t0) ->
+          ('b * 'a f F.t) option;
+      }
+
+      let map (type b c) (f : c t) (mkt : b Account_type.f -> Account_type.t0) :
+          b f -> (c * b f) option =
+        let module Inst =
+          Account_structure0.Visitor (F) (Structure)
+            (struct
+              type 'b t = (c * 'b f) option
+            end)
+        in
+        Inst.visit
+          {
+            car =
+              (fun (type inner)
+                v
+                (module Gen_cons : Account_structure0.Gen_f_cons.S
+                  with type inner = inner
+                   and type outer = b)
+              ->
+                let open Option.Let_syntax in
+                let module Type_cons =
+                  Gen_cons.Specialize (Account_type.Scaffold) (Account_type)
+                in
+                let module Own_cons = Gen_cons.Specialize (F) (Structure) in
+                let%map c, v' = f.car v (fun el -> mkt (Type_cons.cons el)) in
+                (c, Own_cons.cons v'));
+          }
+    end
+  end
 
-  include Account_structure (struct
-    type 'a t = 'a elem [@@deriving sexp_of]
-  end)
-end
+  module Typed_account_path = struct
+    type 'a elem = Leaf | Node of string * 'a | Ind of string * 'a elem
+    [@@deriving sexp_of]
 
-module Account_path = struct
-  type t = string list [@@deriving compare, sexp]
+    include Account_structure (struct
+      type 'a t = 'a elem [@@deriving sexp_of]
+    end)
+  end
 
-  module Map = Map.Make (struct
-    type nonrec t = t [@@deriving compare, sexp]
-  end)
-end
+  module Account_path = struct
+    type t = string list [@@deriving compare, sexp]
 
-module Account_hierarchy = struct
-  (* The contents of an account of category 'a *)
-  type 'a core =
-    (* Comprises of subaccounts of its subcategories *)
-    | Node of 'a String.Map.t
-    (* Comprises of subaccounts of its own category *)
-    | Ind of 'a account String.Map.t
-    (* Has no subaccounts, has a balance in a certain commodity *)
-    | Leaf of Commodity_id.t * Money.Diff.t
-  [@@deriving sexp_of]
+    module Map = Map.Make (struct
+      type nonrec t = t [@@deriving compare, sexp]
+    end)
+  end
 
-  and extra = { description : String.t } [@@deriving sexp_of]
-  and 'a account = extra * 'a core
+  module Account_hierarchy = struct
+    (* The contents of an account of category 'a *)
+    type 'a core =
+      (* Comprises of subaccounts of its subcategories *)
+      | Node of 'a String.Map.t
+      (* Comprises of subaccounts of its own category *)
+      | Ind of 'a account String.Map.t
+      (* Has no subaccounts, has a balance in a certain commodity *)
+      | Leaf of Commodity_id.t * Money.Diff.t
+    [@@deriving sexp_of]
 
-  include Account_structure (struct
-    type 'a t = 'a account [@@deriving sexp_of]
-  end)
+    and extra = { description : String.t } [@@deriving sexp_of]
+    and 'a account = extra * 'a core
 
-  (* All accounts *)
-  type world = t0 String.Map.t
-
-  let rec unsafe_alter_aux (subaid : Account_path.t)
-      (f :
-        Account_type.t0 ->
-        extra ->
-        Commodity_id.t ->
-        Money.Diff.t ->
-        'a * extra * Money.Diff.t) : 'a Mapper.t =
-    {
-      car =
-        (fun in_acc mkt ->
+    module Scaffold = struct
+      type 'a t = 'a account [@@deriving sexp_of]
+    end
+
+    module Structure = Account_structure (Scaffold)
+
+    (* All accounts *)
+    type world = Structure.t0 String.Map.t
+
+    let rec unsafe_alter_aux (subaid : Account_path.t)
+        (f :
+          Account_type.t0 ->
+          extra ->
+          Commodity_id.t ->
+          Money.Diff.t ->
+          'a * extra * Money.Diff.t) : 'a Structure.Mapper.t =
+      {
+        car =
+          (fun in_acc mkt ->
+            let open Option.Let_syntax in
+            match (subaid, in_acc) with
+            | [], (extra, Leaf (acc_comm, acc_bal)) ->
+                let x, extra', acc_bal' =
+                  f (mkt Account_type.Leaf) extra acc_comm acc_bal
+                in
+                Some (x, (extra', Leaf (acc_comm, acc_bal')))
+            | [], _ -> None
+            | subaid0 :: subaid, (extra, Node subaccs) ->
+                let%bind subacc = Map.find subaccs subaid0 in
+                let%map x, subacc' =
+                  Structure.Mapper.map
+                    (unsafe_alter_aux subaid f)
+                    (fun k -> mkt (Node k))
+                    subacc
+                in
+                (x, (extra, Node (Map.set subaccs ~key:subaid0 ~data:subacc')))
+            | subaid0 :: subaid, (extra, Ind subaccs) ->
+                let%bind subacc = Map.find subaccs subaid0 in
+                let%map x, subacc' =
+                  (unsafe_alter_aux subaid f).car subacc mkt
+                in
+                (x, (extra, Ind (Map.set subaccs ~key:subaid0 ~data:subacc')))
+            | _ :: _, (_, Leaf _) -> None);
+      }
+
+    let unsafe_alter (aid : Account_path.t)
+        (f :
+          Account_type.t0 ->
+          extra ->
+          Commodity_id.t ->
+          Money.Diff.t ->
+          'a * extra * Money.Diff.t) (w : world) : ('a * world) option =
+      match aid with
+      | [] -> None
+      | aid0 :: subaid -> (
           let open Option.Let_syntax in
-          match (subaid, in_acc) with
-          | [], (extra, Leaf (acc_comm, acc_bal)) ->
-              let x, extra', acc_bal' =
-                f (mkt Account_type.Leaf) extra acc_comm acc_bal
+          match%bind Map.find w aid0 with
+          | Asset acc ->
+              let%map x, acc' =
+                (unsafe_alter_aux subaid f).car acc (fun k -> Asset k)
               in
-              Some (x, (extra', Leaf (acc_comm, acc_bal')))
-          | [], _ -> None
-          | subaid0 :: subaid, (extra, Node subaccs) ->
-              let%bind subacc = Map.find subaccs subaid0 in
-              let%map x, subacc' =
-                Mapper.map
-                  (unsafe_alter_aux subaid f)
-                  (fun k -> mkt (Node k))
-                  subacc
+              (x, Map.set w ~key:aid0 ~data:(Asset acc'))
+          | Expense acc ->
+              let%map x, acc' =
+                (unsafe_alter_aux subaid f).car acc (fun k -> Expense k)
               in
-              (x, (extra, Node (Map.set subaccs ~key:subaid0 ~data:subacc')))
-          | subaid0 :: subaid, (extra, Ind subaccs) ->
-              let%bind subacc = Map.find subaccs subaid0 in
-              let%map x, subacc' = (unsafe_alter_aux subaid f).car subacc mkt in
-              (x, (extra, Ind (Map.set subaccs ~key:subaid0 ~data:subacc')))
-          | _ :: _, (_, Leaf _) -> None);
-    }
+              (x, Map.set w ~key:aid0 ~data:(Expense acc'))
+          | Income acc ->
+              let%map x, acc' =
+                (unsafe_alter_aux subaid f).car acc (fun k -> Income k)
+              in
+              (x, Map.set w ~key:aid0 ~data:(Income acc'))
+          | Liability acc ->
+              let%map x, acc' =
+                (unsafe_alter_aux subaid f).car acc (fun k -> Liability k)
+              in
+              (x, Map.set w ~key:aid0 ~data:(Liability acc'))
+          | Equity acc ->
+              let%map x, acc' =
+                (unsafe_alter_aux subaid f).car acc (fun k -> Equity k)
+              in
+              (x, Map.set w ~key:aid0 ~data:(Equity acc')))
+
+    (** Update the balance (debit/credit ([dc])) of account [aid] [by_amount]
+        (commodity: [in_comm]) in [world], giving the updated world and the pre
+        and post balances for [aid] iff the account exists in [world]. *)
+    let update_bal aid dc by_amount in_comm (w : world) :
+        (Money.Diff.t * Money.Diff.t * world) option =
+      let open Option.Let_syntax in
+      let%bind mres, w' =
+        unsafe_alter aid
+          (fun acc_type acc_extra acc_comm acc_bal ->
+            if not ([%equal: Commodity_id.t] acc_comm in_comm) then
+              (None, acc_extra, acc_bal)
+            else
+              let on_debit =
+                match acc_type with
+                | Asset _ -> `Incr
+                | Expense _ -> `Incr
+                | Income _ -> `Decr
+                | Liability _ -> `Decr
+                | Equity _ -> `Decr
+              in
+              let acc_bal' =
+                Money.Diff.(acc_bal + of_amount by_amount dc ~on_debit)
+              in
+              (Some (acc_bal, acc_bal'), acc_extra, acc_bal'))
+          w
+      in
+      let%map pre_bal, post_bal = mres in
+      (pre_bal, post_bal, w')
+
+    let get_bal aid (w : world) : (Commodity_id.t * Money.Diff.t) option =
+      let open Option.Let_syntax in
+      let%map cb, _world' =
+        unsafe_alter aid
+          (fun _acc_type acc_extra acc_comm acc_bal ->
+            ((acc_comm, acc_bal), acc_extra, acc_bal))
+          w
+      in
+      cb
+
+    let add_balance_maps m1 m2 : Money.Diff.t Commodity_id.Map.t =
+      Map.merge m1 m2 ~f:(fun ~key:_comm -> function
+        | `Both (b1, b2) -> Some Money.Diff.(b1 + b2)
+        | `Left b | `Right b -> Some b)
+
+    let rec collect_balances : type a.
+        a Structure.f account -> Money.Diff.t Commodity_id.Map.t = function
+      | _extra, Leaf (acc_comm, acc_bal) ->
+          Commodity_id.Map.singleton acc_comm acc_bal
+      | _extra, Ind subaccs ->
+          Map.fold subaccs ~init:Commodity_id.Map.empty
+            ~f:(fun ~key:_ ~data:subacc comm_bal_sums ->
+              add_balance_maps comm_bal_sums (collect_balances subacc))
+      | _extra, Node subaccs ->
+          Map.fold subaccs ~init:Commodity_id.Map.empty
+            ~f:(fun ~key:_ ~data:subacc comm_bal_sums ->
+              let module Visitor =
+                Account_structure0.Basic_visitor (Scaffold) (Structure)
+              in
+              add_balance_maps comm_bal_sums
+                (Visitor.visit { car = collect_balances } subacc))
+
+    type delete_error = Not_found | Nonzero_balance
 
-  let unsafe_alter (aid : Account_path.t)
-      (f :
-        Account_type.t0 ->
-        extra ->
-        Commodity_id.t ->
-        Money.Diff.t ->
-        'a * extra * Money.Diff.t) (w : world) : ('a * world) option =
-    match aid with
-    | [] -> None
-    | aid0 :: subaid -> (
-        let open Option.Let_syntax in
-        match%bind Map.find w aid0 with
-        | Asset acc ->
-            let%map x, acc' =
-              (unsafe_alter_aux subaid f).car acc (fun k -> Asset k)
-            in
-            (x, Map.set w ~key:aid0 ~data:(Asset acc'))
-        | Expense acc ->
-            let%map x, acc' =
-              (unsafe_alter_aux subaid f).car acc (fun k -> Expense k)
-            in
-            (x, Map.set w ~key:aid0 ~data:(Expense acc'))
-        | Income acc ->
-            let%map x, acc' =
-              (unsafe_alter_aux subaid f).car acc (fun k -> Income k)
-            in
-            (x, Map.set w ~key:aid0 ~data:(Income acc'))
-        | Liability acc ->
-            let%map x, acc' =
-              (unsafe_alter_aux subaid f).car acc (fun k -> Liability k)
-            in
-            (x, Map.set w ~key:aid0 ~data:(Liability acc'))
-        | Equity acc ->
-            let%map x, acc' =
-              (unsafe_alter_aux subaid f).car acc (fun k -> Equity k)
-            in
-            (x, Map.set w ~key:aid0 ~data:(Equity acc')))
-
-  (** Update the balance (debit/credit ([dc])) of account [aid] [by_amount]
-      (commodity: [in_comm]) in [world], giving the updated world and the pre
-      and post balances for [aid] iff the account exists in [world]. *)
-  let update_bal aid dc by_amount in_comm (w : world) :
-      (Money.Diff.t * Money.Diff.t * world) option =
-    let open Option.Let_syntax in
-    let%bind mres, w' =
-      unsafe_alter aid
-        (fun acc_type acc_extra acc_comm acc_bal ->
-          if not ([%equal: Commodity_id.t] acc_comm in_comm) then
-            (None, acc_extra, acc_bal)
-          else
-            let on_debit =
-              match acc_type with
-              | Asset _ -> `Incr
-              | Expense _ -> `Incr
-              | Income _ -> `Decr
-              | Liability _ -> `Decr
-              | Equity _ -> `Decr
-            in
-            let acc_bal' =
-              Money.Diff.(acc_bal + of_amount by_amount dc ~on_debit)
-            in
-            (Some (acc_bal, acc_bal'), acc_extra, acc_bal'))
-        w
-    in
-    let%map pre_bal, post_bal = mres in
-    (pre_bal, post_bal, w')
-
-  let get_bal aid (w : world) : (Commodity_id.t * Money.Diff.t) option =
-    let open Option.Let_syntax in
-    let%map cb, _world' =
-      unsafe_alter aid
-        (fun _acc_type acc_extra acc_comm acc_bal ->
-          ((acc_comm, acc_bal), acc_extra, acc_bal))
-        w
-    in
-    cb
-
-  let add_balance_maps m1 m2 : Money.Diff.t Commodity_id.Map.t =
-    Map.merge m1 m2 ~f:(fun ~key:_comm -> function
-      | `Both (b1, b2) -> Some Money.Diff.(b1 + b2)
-      | `Left b | `Right b -> Some b)
-
-  let rec collect_balances : type a.
-      a f account -> Money.Diff.t Commodity_id.Map.t = function
-    | _extra, Leaf (acc_comm, acc_bal) ->
-        Commodity_id.Map.singleton acc_comm acc_bal
-    | _extra, Ind subaccs ->
-        Map.fold subaccs ~init:Commodity_id.Map.empty
-          ~f:(fun ~key:_ ~data:subacc comm_bal_sums ->
-            add_balance_maps comm_bal_sums (collect_balances subacc))
-    | _extra, Node subaccs ->
-        Map.fold subaccs ~init:Commodity_id.Map.empty
-          ~f:(fun ~key:_ ~data:subacc comm_bal_sums ->
-            add_balance_maps comm_bal_sums
-              (Folder.fold { car = collect_balances } subacc))
-
-  type delete_error = Not_found | Nonzero_balance
-
-  (*
+    (*
   let rec delete_aux : type a. (Account_path.t * a f account) -> (a f account, delete_error) result = function
     | [], (extra, Leaf (_acc_comm, acc_bal)) ->
        if Money.Diff.(acc_bal = ~$0) then 
@@ -516,152 +528,152 @@ module Account_hierarchy = struct
   let delete (aid : Account_path.t) (w : world) =
    *)
 
-  let world_inst : world =
-    String.Map.of_alist_exn
-      [
-        ( "Assets",
-          Asset
-            ( { description = "assets" },
-              Ind
-                (String.Map.of_alist_exn
-                   [
-                     ( "Current",
-                       ( { description = "current" },
-                         Node
-                           (String.Map.of_alist_exn
-                              [
-                                ( "Checking",
-                                  Bank
-                                    ( { description = "bnak accounts" },
-                                      Ind
-                                        (String.Map.of_alist_exn
-                                           [
-                                             ( "ING",
-                                               ( { description = "ING bank" },
-                                                 Leaf ("EUC", Money.Diff.(~$0))
-                                               ) );
-                                             ( "N26",
-                                               ( { description = "ING bank" },
-                                                 Leaf ("EUC", Money.Diff.(~$0))
-                                               ) );
-                                           ]) ) );
-                              ]) ) );
-                   ]) ) );
-      ]
-end
+    let world_inst : world =
+      String.Map.of_alist_exn
+        [
+          ( "Assets",
+            Structure.Asset
+              ( { description = "assets" },
+                Ind
+                  (String.Map.of_alist_exn
+                     [
+                       ( "Current",
+                         ( { description = "current" },
+                           Node
+                             (String.Map.of_alist_exn
+                                [
+                                  ( "Checking",
+                                    Structure.Bank
+                                      ( { description = "bnak accounts" },
+                                        Ind
+                                          (String.Map.of_alist_exn
+                                             [
+                                               ( "ING",
+                                                 ( { description = "ING bank" },
+                                                   Leaf ("EUC", Money.Diff.(~$0))
+                                                 ) );
+                                               ( "N26",
+                                                 ( { description = "ING bank" },
+                                                   Leaf ("EUC", Money.Diff.(~$0))
+                                                 ) );
+                                             ]) ) );
+                                ]) ) );
+                     ]) ) );
+        ]
+  end
 
-module Bal_assert = struct
-  type t = { account : Account_path.t; labels : Labels.t; bal : Money.Diff.t }
-  [@@deriving sexp_of]
-end
+  module Bal_assert = struct
+    type t = { account : Account_path.t; labels : Labels.t; bal : Money.Diff.t }
+    [@@deriving sexp_of]
+  end
 
-module Account_decl = struct
-  type t = {
-    type_ : Account_type.t0;
-    parent : Account_path.t;
-    name : string;
-    commodity : Commodity_id.t;
-    extra : Account_hierarchy.extra;
-  }
-  [@@deriving sexp_of]
-end
+  module Account_decl = struct
+    type t = {
+      type_ : Account_type.t0;
+      parent : Account_path.t;
+      name : string;
+      commodity : Commodity_id.t;
+      extra : Account_hierarchy.extra;
+    }
+    [@@deriving sexp_of]
+  end
 
-module Tx : sig
-  type entry = {
-    dc : Debit_credit.t;
-    commodity : Commodity_id.t;
-    amount : Money.Amount.t;
-    assertion : Money.Diff.t option;
-  }
-
-  (* Private because we only want to allow constructing balanced transactions. *)
-  type t = private {
-    cleared : Date.t option;
-    entries : entry Account_path.Map.t;
-    labels : Labels.t;
-  }
-
-  type error = Unbalanced
-
-  val make :
-    cleared:Date.t option ->
-    entries:entry Account_path.Map.t ->
-    labels:Labels.t ->
-    (t, error) result
-
-  val sexp_of_t : t -> Sexp.t
-end = struct
-  type entry = {
-    dc : Debit_credit.t;
-    commodity : Commodity_id.t;
-    amount : Money.Amount.t;
-    assertion : Money.Diff.t option;
-  }
-  [@@deriving sexp_of]
+  module Tx : sig
+    type entry = {
+      dc : Debit_credit.t;
+      commodity : Commodity_id.t;
+      amount : Money.Amount.t;
+      assertion : Money.Diff.t option;
+    }
 
-  type t = {
-    cleared : Date.t option;
-    entries : entry Account_path.Map.t;
-    labels : Labels.t;
-  }
-  [@@deriving sexp_of]
+    (* Private because we only want to allow constructing balanced transactions. *)
+    type t = private {
+      cleared : Date.t option;
+      entries : entry Account_path.Map.t;
+      labels : Labels.t;
+    }
 
-  type error = Unbalanced
-
-  let is_balanced entries =
-    Map.fold entries ~init:Commodity_id.Map.empty
-      ~f:(fun ~key:_ ~data comm_balances ->
-        Map.update comm_balances data.commodity ~f:(fun ocomm_bal ->
-            let comm_bal = Option.value ocomm_bal ~default:Money.Diff.(~$0) in
-            match data.dc with
-            | Debit_credit.Debit -> Money.Diff.(comm_bal +% data.amount)
-            | Debit_credit.Credit -> Money.Diff.(comm_bal -% data.amount)))
-    |> Map.for_all ~f:(fun comm_bal -> Money.Diff.(comm_bal = ~$0))
-
-  let make ~cleared ~entries ~labels =
-    if not (is_balanced entries) then Error Unbalanced
-    else Ok { cleared; entries; labels }
-end
+    type error = Unbalanced
+
+    val make :
+      cleared:Date.t option ->
+      entries:entry Account_path.Map.t ->
+      labels:Labels.t ->
+      (t, error) result
+
+    val sexp_of_t : t -> Sexp.t
+  end = struct
+    type entry = {
+      dc : Debit_credit.t;
+      commodity : Commodity_id.t;
+      amount : Money.Amount.t;
+      assertion : Money.Diff.t option;
+    }
+    [@@deriving sexp_of]
+
+    type t = {
+      cleared : Date.t option;
+      entries : entry Account_path.Map.t;
+      labels : Labels.t;
+    }
+    [@@deriving sexp_of]
 
-type item =
-  | Tx_item of Tx.t
-  | Bal_assert_item of Bal_assert.t
-  | Account_decl_item of Account_decl.t
-[@@deriving sexp_of]
+    type error = Unbalanced
+
+    let is_balanced entries =
+      Map.fold entries ~init:Commodity_id.Map.empty
+        ~f:(fun ~key:_ ~data comm_balances ->
+          Map.update comm_balances data.commodity ~f:(fun ocomm_bal ->
+              let comm_bal = Option.value ocomm_bal ~default:Money.Diff.(~$0) in
+              match data.dc with
+              | Debit_credit.Debit -> Money.Diff.(comm_bal +% data.amount)
+              | Debit_credit.Credit -> Money.Diff.(comm_bal -% data.amount)))
+      |> Map.for_all ~f:(fun comm_bal -> Money.Diff.(comm_bal = ~$0))
+
+    let make ~cleared ~entries ~labels =
+      if not (is_balanced entries) then Error Unbalanced
+      else Ok { cleared; entries; labels }
+  end
 
-type t = item list [@@deriving sexp_of]
+  type item =
+    | Tx_item of Tx.t
+    | Bal_assert_item of Bal_assert.t
+    | Account_decl_item of Account_decl.t
+  [@@deriving sexp_of]
 
-module World = struct
-  type t = Account_hierarchy.world
+  type t = item list [@@deriving sexp_of]
 
-  let empty : t = String.Map.empty
+  module World = struct
+    type t = Account_hierarchy.world
 
-  let apply_tx (tx : Tx.t) world : t option =
-    Map.fold_option tx.entries ~init:world
-      ~f:(fun ~key:aid ~(data : Tx.entry) world ->
-        let open Option.Let_syntax in
-        let%bind _old_bal, new_bal, world =
-          Account_hierarchy.update_bal aid data.dc data.amount data.commodity
-            world
-        in
-        match data.assertion with
-        | None -> Some world
-        | Some bal_ass ->
-            if Money.Diff.(bal_ass = new_bal) then Some world else None)
-
-  let apply_ba (ba : Bal_assert.t) world : t option =
-    let open Option.Let_syntax in
-    let%bind _comm, bal = Account_hierarchy.get_bal ba.account world in
-    if not Money.Diff.(bal = ba.bal) then None else Some world
-
-  let apply_ad (_ad : Account_decl.t) _world : t option = None
-
-  let apply : item -> t -> t option = function
-    | Tx_item tx -> apply_tx tx
-    | Bal_assert_item ba -> apply_ba ba
-    | Account_decl_item ad -> apply_ad ad
-end
+    let empty : t = String.Map.empty
+
+    let apply_tx (tx : Tx.t) world : t option =
+      Map.fold_option tx.entries ~init:world
+        ~f:(fun ~key:aid ~(data : Tx.entry) world ->
+          let open Option.Let_syntax in
+          let%bind _old_bal, new_bal, world =
+            Account_hierarchy.update_bal aid data.dc data.amount data.commodity
+              world
+          in
+          match data.assertion with
+          | None -> Some world
+          | Some bal_ass ->
+              if Money.Diff.(bal_ass = new_bal) then Some world else None)
+
+    let apply_ba (ba : Bal_assert.t) world : t option =
+      let open Option.Let_syntax in
+      let%bind _comm, bal = Account_hierarchy.get_bal ba.account world in
+      if not Money.Diff.(bal = ba.bal) then None else Some world
+
+    let apply_ad (_ad : Account_decl.t) _world : t option = None
+
+    let apply : item -> t -> t option = function
+      | Tx_item tx -> apply_tx tx
+      | Bal_assert_item ba -> apply_ba ba
+      | Account_decl_item ad -> apply_ad ad
+  end
 
-module Ctxd_item = struct end
+  module Ctxd_item = struct end
 
-let make = Fn.id
+  let make = Fn.id