Source file `html_fragment_json.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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
(* Rendering of HTML fragments together with metadata. For embedding the
   generated documentation in existing websites.
*)
open Odoc_utils

module Html = Tyxml.Html
module Url = Odoc_document.Url

let json_of_html config h =
  let htmlpp = Html.pp_elt ~indent:(Config.indent config) () in
  String.concat ~sep:"" (List.map (Format.asprintf "%a" htmlpp) h)

let json_of_resource (r : Odoc_extension_registry.resource) : Json.json =
  match r with
  | Js_url url -> `Object [ ("type", `String "js_url"); ("value", `String url) ]
  | Css_url url -> `Object [ ("type", `String "css_url"); ("value", `String url) ]
  | Js_inline code -> `Object [ ("type", `String "js_inline"); ("value", `String code) ]
  | Css_inline code -> `Object [ ("type", `String "css_inline"); ("value", `String code) ]

let json_of_resources resources : Json.json =
  `Array (List.map json_of_resource resources)

let json_of_asset (a : Odoc_extension_registry.asset) : Json.json =
  (* For JSON output, we encode binary content as base64 *)
  let content_b64 = Base64.encode_string (Bytes.to_string a.asset_content) in
  `Object [
    ("filename", `String a.asset_filename);
    ("content_base64", `String content_b64);
  ]

let json_of_assets assets : Json.json =
  `Array (List.map json_of_asset assets)

let json_of_breadcrumbs config (breadcrumbs : Types.breadcrumbs) : Json.json =
  let breadcrumb (b : Types.breadcrumb) =
    `Object
      [
        ("name", `String (json_of_html config b.name));
        ("href", match b.href with None -> `Null | Some href -> `String href);
        ("kind", `String (Url.Path.string_of_kind b.kind));
      ]
  in
  let json_breadcrumbs =
    breadcrumbs.parents @ [ breadcrumbs.current ] |> List.map breadcrumb
  in
  `Array json_breadcrumbs

let json_of_toc (toc : Types.toc list) : Json.json =
  let rec section (s : Types.toc) =
    `Object
      [
        ("title", `String s.title_str);
        ("href", `String s.href);
        ("children", `Array (List.map section s.children));
      ]
  in
  let toc_json_list = toc |> List.map section in
  `Array toc_json_list

let json_of_sidebar config sidebar =
  match sidebar with
  | None -> `Null
  | Some sidebar -> `String (json_of_html config sidebar)

let make ~config ~preamble ~url ~breadcrumbs ~toc ~uses_katex ~source_anchor
    ~resources ~assets ~header content children =
  let filename = Link.Path.as_filename ~config url in
  let filename = Fpath.add_ext ".json" filename in
  let json_to_string json = Json.to_string json in
  let source_anchor =
    match source_anchor with Some url -> `String url | None -> `Null
  in
  let content ppf =
    Format.pp_print_string ppf
      (json_to_string
         (`Object
            [
              ("header", `String (json_of_html config header));
              ("type", `String "documentation");
              ("uses_katex", `Bool uses_katex);
              ("breadcrumbs", json_of_breadcrumbs config breadcrumbs);
              ("toc", json_of_toc toc);
              ("source_anchor", source_anchor);
              ("preamble", `String (json_of_html config preamble));
              ("content", `String (json_of_html config content));
              ("resources", json_of_resources resources);
              ("assets", json_of_assets assets);
            ]))
  in
  { Odoc_document.Renderer.filename; content; children; path = url; assets }

let make_src ~config ~url ~breadcrumbs ~sidebar ~header content =
  let filename = Link.Path.as_filename ~config url in
  let filename = Fpath.add_ext ".json" filename in
  let htmlpp = Html.pp_elt ~indent:(Config.indent config) () in
  let json_to_string json = Json.to_string json in
  let global_toc = json_of_sidebar config sidebar in
  let content ppf =
    Format.pp_print_string ppf
      (json_to_string
         (`Object
            [
              ("type", `String "source");
              ("breadcrumbs", json_of_breadcrumbs config breadcrumbs);
              ("global_toc", global_toc);
              ("header", `String (json_of_html config header));
              ( "content",
                `String
                  (String.concat ~sep:""
                     (List.map (Format.asprintf "%a" htmlpp) content)) );
            ]))
  in
  { Odoc_document.Renderer.filename; content; children = []; path = url; assets = [] }

(* Register as the "json" shell *)
let () =
  Html_shell.register
    (module struct
      let name = "json"

      let make ~config (data : Html_shell.page_data) =
        make ~config
          ~preamble:(data.preamble :> Html_types.flow5 Html.elt list)
          ~header:data.header ~breadcrumbs:data.breadcrumbs ~toc:data.toc
          ~url:data.url ~uses_katex:data.uses_katex
          ~source_anchor:data.source_anchor ~resources:data.resources
          ~assets:data.assets data.content data.children

      let make_src ~config (data : Html_shell.src_page_data) =
        make_src ~config ~url:data.url ~breadcrumbs:data.breadcrumbs
          ~sidebar:data.sidebar ~header:data.header data.content
    end)
Source file html_fragment_json.ml

Source file `html_fragment_json.ml`
