From 7358567e5526423b1b2c11fb93585f3642e4cb88 Mon Sep 17 00:00:00 2001
From: rand00 <oth.rand@gmail.com>
Date: Wed, 2 Feb 2022 22:59:32 +0100
Subject: [PATCH] Utils: Moved omd-helpers into Omd submodule here

---
 lib/utils.ml | 80 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 80 insertions(+)

diff --git a/lib/utils.ml b/lib/utils.ml
index b2a3f75..93ba6ad 100644
--- a/lib/utils.ml
+++ b/lib/utils.ml
@@ -44,3 +44,83 @@ let compare_pkgs p1 p2 =
     String_map.empty (Astring.String.cuts ~sep:"\n" p)
   in
   diff_map (parse_pkgs p1) (parse_pkgs p2)
+
+module Omd = struct
+
+  let make_safe omd =
+    let rec safe_block = function
+      | Omd.Paragraph (attr, inline) ->
+        safe_inline inline
+        |> Option.map (fun inline -> Omd.Paragraph (attr, inline))
+      | Omd.List (attr, typ, spacing, blocks) ->
+        let blocks = List.filter_map (fun b ->
+          let b = List.filter_map safe_block b in
+          if b = [] then None else Some b)
+          blocks
+        in
+        if blocks = [] then None else
+          Some (Omd.List (attr, typ, spacing, blocks))
+      | Omd.Blockquote (attr, blocks) ->
+        let blocks = List.filter_map safe_block blocks in
+        if blocks = [] then None else
+          Some (Omd.Blockquote (attr, blocks))
+      | Omd.Heading (attr, level, inline) ->
+        safe_inline inline
+        |> Option.map (fun inline -> Omd.Heading (attr, level, inline))
+      | Omd.Html_block _ -> None
+      | Omd.Definition_list (attr, def_elts) ->
+        let def_elts = List.filter_map safe_def_elts def_elts in
+        if def_elts = [] then None else
+          Some (Omd.Definition_list (attr, def_elts))
+      | Omd.Code_block _
+      | Omd.Thematic_break _ as v -> Some v
+    and safe_def_elts { term ; defs } =
+      let defs = List.filter_map safe_inline defs in
+      safe_inline term
+      |> Option.map (fun term -> { Omd.term ; defs })
+    and safe_inline = function
+      | Concat (attr, inline) ->
+        Some (Concat (attr, List.filter_map safe_inline inline))
+      | Emph (attr, inline) ->
+        safe_inline inline
+        |> Option.map (fun inline -> Omd.Emph (attr, inline))
+      | Strong (attr, inline) ->
+        safe_inline inline
+        |> Option.map (fun inline -> Omd.Strong (attr, inline))
+      | Link (attr, link) ->
+        begin match safe_link link with
+          | `No_label | `Relative -> safe_inline link.Omd.label
+          | `Link l -> Some (Omd.Link (attr, l))
+        end
+      | Image (attr, link) ->
+        begin match safe_link link with
+          | `No_label | `Relative -> None
+          | `Link l -> Some (Omd.Image (attr, l))
+        end
+      | Html _ -> None
+      | Text _
+      | Code _
+      | Hard_break _
+      | Soft_break _ as v -> Some v
+    and safe_link ({ label ; destination ; _ } as l) =
+      let absolute_link =
+        String.(length destination >= 2 && equal (sub destination 0 2) "//") ||
+        String.(length destination >= 7 && equal (sub destination 0 7) "http://") ||
+        String.(length destination >= 8 && equal (sub destination 0 8) "https://")
+      in
+      if absolute_link then
+        match safe_inline label with
+        | None -> `No_label
+        | Some label -> `Link { l with label }
+      else
+        `Relative
+    in
+    List.filter_map safe_block omd
+
+  let html_of_string markdown =
+    markdown
+    |> Omd.of_string 
+    |> make_safe 
+    |> Omd.to_html 
+
+end