From 12d30c337b0dafaefa938b8a62c36b5a4e70bcd0 Mon Sep 17 00:00:00 2001
From: Rutger Broekhoff
Date: Fri, 9 Jan 2026 14:07:43 +0100
Subject: heheh

---
 lib/ledger.ml | 111 ++++++++++++++++++++++++++++++++++++----------------------
 1 file changed, 70 insertions(+), 41 deletions(-)

(limited to 'lib/ledger.ml')

diff --git a/lib/ledger.ml b/lib/ledger.ml
index 928570f..7bb824c 100644
--- a/lib/ledger.ml
+++ b/lib/ledger.ml
@@ -202,33 +202,7 @@ module Account_structure0 = struct
     type 'a t [@@deriving sexp_of]
   end
 
-  module type S = sig
-    include Scaffold
-
-    type 'a f =
-      | Accounts_payable : Categories.final f t -> Categories.liability f
-      | Accounts_receivable : Categories.final f t -> Categories.asset f
-      | Bank : Categories.bank f t -> Categories.asset f
-      | Cash : Categories.final f t -> Categories.asset f
-      | Credit : Categories.final f t -> Categories.liability f
-      | Mutual_fund : Categories.final f t -> Categories.asset f
-      | Stock : Categories.final f t -> Categories.asset f
-      | Savings : Categories.final f t -> Categories.bank f
-      | Checking : Categories.final f t -> Categories.bank f
-    [@@deriving sexp_of]
-
-    type t0 =
-      | Asset of Categories.asset f t
-      | Equity of Categories.equity f t
-      | Expense of Categories.expense f t
-      | Income of Categories.income f t
-      | Liability of Categories.liability f t
-    [@@deriving sexp_of]
-  end
-
-  module Make (F : Scaffold) : S with type 'a t = 'a F.t = struct
-    include F
-
+  module Make (F : Scaffold) = struct
     type 'a f =
       | Accounts_payable : Categories.final f F.t -> Categories.liability f
       | Accounts_receivable : Categories.final f F.t -> Categories.asset f
@@ -249,7 +223,32 @@ module Account_structure0 = struct
       | Liability of Categories.liability f F.t
     [@@deriving sexp_of]
   end
-end
+
+  module Gen_f_cons = struct
+    module type S = sig
+      type inner
+      type outer
+
+      module Specialize : functor
+        (F : Scaffold)
+        (G : module type of Make (F))
+        -> sig
+        val cons : inner G.f F.t -> outer G.f
+      end
+    end
+
+    module Accounts_payable :
+      S with type outer = Categories.liability and type inner = Categories.final =
+    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
+      end
+      end
+    end
+  end
 
 module Account_type = struct
   type 'a elem = Leaf | Node of 'a [@@deriving sexp_of]
@@ -325,22 +324,52 @@ module Account_structure (F : Account_structure0.Scaffold) = struct
       | Checking v -> f.car v
   end
 
-  module Folder2 (H : Account_structure0.S) = struct
-    module type Recons = sig
-      type inner
-      type outer
-
-      module type Make = functor (G : Account_structure0.S) -> sig
-        val recons : inner G.f G.t -> outer G.f
-      end
-    end
-
+  module Folder2 = struct
     type nonrec ('outer, 'acc) t = {
-      car : 'inner. 'inner f F.t -> ('inner H.f H.t -> 'outer H.f) -> 'acc;
+      car :
+        'inner.
+        'inner f F.t ->
+        (module Account_structure0.Gen_f_cons.S
+           with type inner = 'inner
+            and type outer = 'outer) ->
+        'acc;
     }
 
     let fold (type a acc) (f : (a, acc) t) : a f -> acc = function
-      | Accounts_payable v -> f.car v (fun inner -> H.Accounts_payable inner)
+      | Accounts_payable v ->
+          f.car v (module Account_structure0.Gen_f_cons.Accounts_payable)
+      | _ -> failwith "kaas"
+    (*
+      | Accounts_receivable v ->
+          f.car v (fun inner -> H.Accounts_receivable inner)
+      | Bank v -> f.car v (fun inner -> H.Bank inner)
+      | Cash v -> f.car v (fun inner -> H.Cash inner)
+      | Credit v -> f.car v (fun inner -> H.Credit inner)
+      | Mutual_fund v -> f.car v (fun inner -> H.Mutual_fund inner)
+      | Stock v -> f.car v (fun inner -> H.Stock inner)
+      | Savings v -> f.car v (fun inner -> H.Savings inner)
+      | Checking v -> f.car v (fun inner -> H.Checking inner) *)
+  end
+
+  module Folder3 (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) ->
+        '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)
+      | _ -> failwith "kaas"
+    (*
       | Accounts_receivable v ->
           f.car v (fun inner -> H.Accounts_receivable inner)
       | Bank v -> f.car v (fun inner -> H.Bank inner)
@@ -349,7 +378,7 @@ module Account_structure (F : Account_structure0.Scaffold) = struct
       | Mutual_fund v -> f.car v (fun inner -> H.Mutual_fund inner)
       | Stock v -> f.car v (fun inner -> H.Stock inner)
       | Savings v -> f.car v (fun inner -> H.Savings inner)
-      | Checking v -> f.car v (fun inner -> H.Checking inner)
+      | Checking v -> f.car v (fun inner -> H.Checking inner) *)
   end
 end
 
-- 
cgit v1.2.3