From 6b377719c10d5ab3343fd5221f99a4a21008e25a Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@dailly.me>
Date: Thu, 14 Mar 2024 08:26:58 +0100
Subject: Initial commit

---
 lib/expression/headers.ml | 89 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 89 insertions(+)
 create mode 100644 lib/expression/headers.ml

(limited to 'lib/expression/headers.ml')

diff --git a/lib/expression/headers.ml b/lib/expression/headers.ml
new file mode 100644
index 0000000..6371e4f
--- /dev/null
+++ b/lib/expression/headers.ml
@@ -0,0 +1,89 @@
+open StdLabels
+
+let truncate buffer n = Buffer.truncate buffer (Buffer.length buffer - n)
+
+module E :
+  Sym.SYM_CHUNK
+    with type 'a obs = buffer:Buffer.t -> unit
+     and type 'a path_repr = 'a -> Buffer.t -> unit = struct
+  type 'a repr = buffer:Buffer.t -> unit
+  type 'a obs = buffer:Buffer.t -> unit
+  type 'a path_repr = 'a -> Buffer.t -> unit
+
+  let group : 'a repr list -> 'a repr =
+   fun args ~buffer ->
+    Buffer.add_string buffer "[";
+    List.iter args ~f:(fun v ->
+        v ~buffer;
+        Buffer.add_string buffer ", ");
+
+    truncate buffer 2;
+    Buffer.add_string buffer "]"
+
+  let arguments : 'a repr list -> 'a repr =
+   fun expressions ~buffer ->
+    Buffer.add_string buffer "(";
+    List.iter expressions ~f:(fun v ->
+        v ~buffer;
+        Buffer.add_string buffer ", ");
+
+    truncate buffer 2;
+    Buffer.add_string buffer ")"
+
+  let observe x ~buffer = x ~buffer
+  let empty : unit -> 'a repr = fun _ ~buffer -> Buffer.add_string buffer "''"
+  let path printer p ~buffer = printer p buffer
+  let literal l ~buffer = Buffer.add_string buffer l
+  let integer l ~buffer = Buffer.add_string buffer l
+
+  let expr expr ~buffer =
+    Buffer.add_char buffer '(';
+    expr ~buffer;
+    Buffer.add_char buffer ')'
+
+  let nvl expression ~buffer =
+    Buffer.add_string buffer "nvl";
+    arguments ~buffer expression
+
+  let concat expression ~buffer = List.iter expression ~f:(fun v -> v ~buffer)
+
+  let join sep expression ~buffer =
+    List.iter expression ~f:(fun v ->
+        v ~buffer;
+        Buffer.add_string buffer sep);
+    truncate buffer (String.length sep)
+
+  let window : 'a repr T.window -> 'a repr list -> 'a repr list -> 'a repr =
+   fun name expressions order ~buffer ->
+    ignore order;
+    let name = T.name_of_window name in
+
+    Buffer.add_string buffer name;
+    arguments ~buffer expressions
+
+  let boperator name e1 e2 ~buffer =
+    e1 ~buffer;
+    Buffer.add_string buffer (T.name_of_operator name);
+    e2 ~buffer
+
+  let gequality name e1 e2 ~buffer =
+    e1 ~buffer;
+    Buffer.add_string buffer (T.name_of_operator name);
+    group ~buffer e2
+
+  let funct name expressions ~buffer =
+    Buffer.add_string buffer name;
+    arguments ~buffer expressions
+
+  let function' name expressions ~buffer =
+    Buffer.add_string buffer (T.name_of_function name);
+    arguments ~buffer expressions
+end
+
+module M = Sym.M (E)
+
+let headers_of_expression :
+    Buffer.t -> ('a -> Buffer.t -> unit) -> 'a T.t -> unit =
+ fun buffer printer expr ->
+  let repr = M.eval expr ~path_repr:printer in
+  E.observe repr ~buffer
-- 
cgit v1.2.3