From 4314dd7db3348893f56e5c3a8e333316248b2351 Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <rudi.grinberg@gmail.com>
Date: Thu, 5 Apr 2018 23:02:25 +0800
Subject: [PATCH] Add some primitives to make writing formatters easier

* ocaml_list
* quoted
* const
* record
---
 src/import.ml | 23 +++++++++++++++++++++++
 1 file changed, 23 insertions(+)

diff --git a/src/import.ml b/src/import.ml
index 961730a5..b233dbaf 100644
--- a/src/import.ml
+++ b/src/import.ml
@@ -138,6 +138,29 @@ module Fmt = struct
   let nl = Format.pp_print_newline
 
   let prefix f g ppf x = f ppf; g ppf x
+
+  let ocaml_list pp fmt = function
+    | [] -> Format.pp_print_string fmt "[]"
+    | l ->
+      Format.fprintf fmt "@[<hv>[ %a@ ]@]"
+        (list ~pp_sep:(fun fmt () -> Format.fprintf fmt "@,; ")
+           pp) l
+
+  let quoted fmt = Format.fprintf fmt "%S"
+
+  let const
+    : 'a t -> 'a -> unit t
+    = fun pp a' fmt () -> pp fmt a'
+
+  let record fmt = function
+    | [] -> Format.pp_print_string fmt "{}"
+    | xs ->
+      let pp fmt (field, pp) =
+        Format.fprintf fmt "@[<hov 1>%s@ =@ %a@]"
+          field pp () in
+      let pp_sep fmt () = Format.fprintf fmt "@,; " in
+      Format.fprintf fmt "@[<hv>{ %a@ }@]"
+        (Format.pp_print_list ~pp_sep pp) xs
 end
 
 (* This is ugly *)