Source file renderers.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
module RenderAttrs = struct
  module C = Cmarkit_renderer.Context
  open Cmarkit

  let add_attr c (key, value) =
    match value with
    | Some value -> C.string c (" " ^ key ^ "=" ^ value)
    | None -> C.string c (" " ^ key)

  let add_attrs c ?(include_id = true) attrs =
    let kv_attrs =
      let kv_attrs = Cmarkit.Attributes.kv_attributes attrs in
      List.map
        (fun ((k, _), v) ->
          let v = match v with None -> None | Some (v, _) -> Some v in
          (k, v))
        kv_attrs
    in
    let class' =
      let class' = Cmarkit.Attributes.class' attrs in
      let class' = List.map (fun (c, _) -> c) class' in
      match class' with
      | [] -> []
      | _ -> [ ("class", Some ("\"" ^ String.concat " " class' ^ "\"")) ]
    in
    let id =
      let id = Cmarkit.Attributes.id attrs in
      match id with
      | Some (id, _) when include_id -> [ ("id", Some ("\"" ^ id ^ "\"")) ]
      | _ -> []
    in
    let attrs = id @ class' @ kv_attrs in
    List.iter (add_attr c) attrs

  let open_block ?(with_newline = true) c tag attrs =
    C.string c "<";
    C.string c tag;
    add_attrs c attrs;
    C.string c ">";
    if with_newline then C.string c "\n"

  let close_block ?(with_newline = true) c tag =
    C.string c "</";
    C.string c tag;
    C.string c ">";
    if with_newline then C.string c "\n"

  let in_block c ?(with_newline = true) tag attrs f =
    open_block ~with_newline c tag attrs;
    f ();
    close_block ~with_newline c tag

  let with_attrs c ?(with_newline = true) attrs f =
    if Attributes.is_empty attrs then f ()
    else in_block c ~with_newline "div" attrs f

  let with_attrs_span c ?(with_newline = true) attrs f =
    if Attributes.is_empty attrs then f ()
    else in_block c ~with_newline "span" attrs f

  let block_lines c = function
    (* newlines only between lines *)
    | [] -> ()
    | (l, _) :: ls ->
        let line c (l, _) =
          C.byte c '\n';
          C.string c l
        in
        C.string c l;
        List.iter (line c) ls
end

let custom_html_renderer =
  let open Cmarkit_renderer in
  let open Cmarkit in
  let open Cmarkit_html in
  let default = renderer ~safe:false () in
  let custom_html =
    let inline c = function
      | Inline.Text ((t, (attrs, _)), _) ->
          (* Put text inside spans to be able to apply styles on them *)
          Context.string c "<span";
          add_attrs c attrs;
          Context.byte c '>';
          html_escaped_string c t;
          Context.string c "</span>";
          true
          (* | Inline.Ext_attrs (attrs_span, _) ->    Context.string c "yooooo"; let (attrs, _) = Inline.Attributes_span.attrs attrs_span and i = Inline.Attributes_span.content attrs_span in     RenderAttrs.with_attrs_span c attrs (fun () -> Context.inline c i); *)
          (*     true *)
      | _ -> false (* let the default HTML renderer handle that *)
    in
    let block c = function
      | Ast.Div ((b, (attrs, _)), _) ->
          RenderAttrs.with_attrs c attrs (fun () -> Context.block c b);
          true
      | Ast.SlipScript ((cb, (attrs, _)), _) ->
          let attrs =
            Attributes.add ("type", Meta.none)
              (Some ("slip-script", Meta.none))
              attrs
          in
          RenderAttrs.in_block c "script" attrs (fun () ->
              RenderAttrs.block_lines c (Block.Code_block.code cb));
          true
      | _ -> false
    in
    make ~inline ~block ()
  in
  compose default custom_html