From 4f3d30df517799ec67887642c324c93696c92c96 Mon Sep 17 00:00:00 2001
From: Cuihtlauac ALVARADO <cuihtmlauac@tarides.com>
Date: Tue, 23 Apr 2024 17:19:57 +0200
Subject: [PATCH] Deserialise and post-process recipes

---
 .../00-yaml.ml                                | 72 ++++++++++++++++++
 .../01-hl_yaml.ml                             | 73 +++++++++++++++++++
 2 files changed, 145 insertions(+)
 create mode 100644 data/cookbook/deserialise-post-process-from-yaml/00-yaml.ml
 create mode 100644 data/cookbook/deserialise-post-process-from-yaml/01-hl_yaml.ml

diff --git a/data/cookbook/deserialise-post-process-from-yaml/00-yaml.ml b/data/cookbook/deserialise-post-process-from-yaml/00-yaml.ml
new file mode 100644
index 0000000000..b0db02c325
--- /dev/null
+++ b/data/cookbook/deserialise-post-process-from-yaml/00-yaml.ml
@@ -0,0 +1,72 @@
+---
+packages:
+- name: yaml
+  tested_version: 3.2.0
+  used_libraries:
+  - yaml
+- name: ppx_deriving_yaml
+  tested_version: 0.2.2
+  used_libraries:
+  - ppx_deriving_yaml
+---
+(* The syntax `{| ... |}` is a quoted string. *)
+let yaml = {|
+french name: pâte sucrée
+ingredients:
+- flour: 250
+- butter: 100
+- sugar: 100
+- egg: 50
+- salt: 5
+steps:
+- soften butter
+- add sugar
+- add egg and salt
+- add flour
+|}
+
+(* The `[@@deriving of_yaml]` attribute makes library `ppx_deriving_yaml` generate the function
+  ``ingredient_of_yaml : Yaml.value -> (ingredient, [> `Msg of string]) result``
+  If both serialising and deserialising are needed, replace `of_yaml` by `yaml`. *)
+type ingredient = {
+  name: string;
+  weight: int;
+} [@@deriving of_yaml]
+
+(* The `[@@deriving of_yaml]` attribute makes library `ppx_deriving_yaml` generate the function
+  ``recipe_of_yaml : Yaml.value -> (ingredient, [> `Msg of string]) result``. *)
+type recipe = {
+  name: string; [@key "french name"]
+  ingredients: ingredient list;
+  steps: string list;
+} [@@deriving of_yaml]
+
+(* Post-processing is needed before using `recipe_of_yaml`.
+  This what function `add_keys` and `at_ingredients` do. *)
+let add_keys : Yaml.value -> Yaml.value = function
+  | `O [(name, `Float weight)] ->
+      `O [
+        ("name", `String name);
+        ("weight", `Float weight);
+      ]
+  | v -> v
+
+let at_ingredients f : Yaml.value -> Yaml.value = function
+  | `O [
+      ("french name", `String name);
+      ("ingredients", `A ingredients);
+      ("steps", `A steps)
+    ] -> `O [
+      ("french name", `String name);
+      ("ingredients", Yaml.Util.map_exn f (`A ingredients));
+      ("steps", `A steps);
+    ]
+  | v -> v
+
+(* Parsing, post-processing and conversion into recordd are chained. *)
+let pate_sucree =
+  yaml
+  |> Yaml.of_string
+  |> Result.map (at_ingredients add_keys)
+  |> fun yaml -> Result.bind yaml recipe_of_yaml
+
diff --git a/data/cookbook/deserialise-post-process-from-yaml/01-hl_yaml.ml b/data/cookbook/deserialise-post-process-from-yaml/01-hl_yaml.ml
new file mode 100644
index 0000000000..8861144312
--- /dev/null
+++ b/data/cookbook/deserialise-post-process-from-yaml/01-hl_yaml.ml
@@ -0,0 +1,73 @@
+---
+packages:
+- name: hl_yaml
+  tested_version: 1.0.0
+  used_libraries:
+  - hl_yaml
+- name: ppx_deriving_yojson
+  tested_version: 3.7.0
+  used_libraries:
+  - ppx_deriving_yojson
+---
+(* The syntax `{| ... |}` is a quoted string. *)
+let yaml = {|
+french name: pâte sucrée
+ingredients:
+- flour: 250
+- butter: 100
+- sugar: 100
+- egg: 50
+- salt: 5
+steps:
+- soften butter
+- add sugar
+- add egg and salt
+- add flour
+|}
+
+(* The `[@@deriving of_yojson]` attribute makes library `ppx_deriving_yojson` generate the function
+  `ingredient_of_yojson : Yojson.Safe.t -> (ingredient, string) result`.
+  If both serialising and deserialising are needed, replace `of_yojson` by `yojson`. *)
+type ingredient = {
+  name: string;
+  weight: int;
+} [@@deriving of_yojson]
+
+(* The `[@@deriving of_yojson]` attribute makes library `ppx_deriving_yojson` generate the function
+  ``recipe_of_yojson : Yojson.Safe.t -> (ingredient, string) result``. *)
+type recipe = {
+  name: string; [@key "french name"]
+  ingredients: ingredient list;
+  steps: string list;
+} [@@deriving of_yojson]
+
+(* Post-processing is needed before using `recipe_of_yojson`.
+  This what function `add_keys` and `at_ingredients` do. *)
+let add_keys : Yojson.Safe.t -> Yojson.Safe.t = function
+  | `Assoc [(name, `Int weight)] ->
+      `Assoc [
+        ("name", `String name);
+        ("weight", `Int weight);
+      ]
+  | v -> v
+
+let at_ingredients f : Yojson.Safe.t -> Yojson.Safe.t = function
+  | `Assoc [
+      ("french name", `String name);
+      ("ingredients", `List ingredients);
+      ("steps", `List steps)
+    ] -> `Assoc [
+      ("french name", `String name);
+      ("ingredients", Yojson.Safe.Util.map f (`List ingredients));
+      ("steps", `List steps);
+    ]
+  | v -> v
+
+(* Parsing receives post-processing and conversion into record as an argument. *)
+let pate_sucree =
+  let of_yojson json =
+    json
+    |> at_ingredients add_keys
+    |> recipe_of_yojson in
+  yaml
+  |> Hl_yaml.Unix.parse ~of_yojson