Source file `indexing.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
open Astring
open Odoc_json_index
open Or_error
open Odoc_model

let handle_file file ~unit ~page =
  Odoc_file.load file >>= fun unit' ->
  match unit' with
  | { Odoc_file.content = Unit_content unit'; _ } when unit'.hidden ->
      Error (`Msg "Hidden units are ignored when generating an index")
  | { Odoc_file.content = Unit_content unit'; _ } (* when not unit'.hidden *) ->
      Ok (unit unit')
  | { Odoc_file.content = Page_content page'; _ } -> Ok (page page')
  | _ ->
      Error
        (`Msg
          "Only pages and unit are allowed as input when generating an index")

let parse_input_file input =
  let is_sep = function '\n' | '\r' -> true | _ -> false in
  Fs.File.read input >>= fun content ->
  let files =
    String.fields ~empty:false ~is_sep content |> List.rev_map Fs.File.of_string
  in
  Ok files

let parse_input_files input =
  List.fold_left
    (fun acc file ->
      acc >>= fun acc ->
      parse_input_file file >>= fun files -> Ok (files :: acc))
    (Ok []) input
  >>= fun files -> Ok (List.concat files)

let compile ~output ~warnings_options inputs_in_file inputs =
  parse_input_files inputs_in_file >>= fun files ->
  let files = List.rev_append inputs files in
  let output_channel =
    Fs.Directory.mkdir_p (Fs.File.dirname output);
    open_out_bin (Fs.File.to_string output)
  in
  let output = Format.formatter_of_out_channel output_channel in
  let print f first up =
    if not first then Format.fprintf output ",";
    f output up;
    false
  in
  Format.fprintf output "[";
  let index () =
    List.fold_left
      (fun acc file ->
        match
          handle_file
            ~unit:(print Json_search.unit acc)
            ~page:(print Json_search.page acc)
            file
        with
        | Ok acc -> acc
        | Error (`Msg m) ->
            Error.raise_warning ~non_fatal:true
              (Error.filename_only "%s" m (Fs.File.to_string file));
            acc)
      true files
  in
  let result = Error.catch_warnings index in
  result |> Error.handle_warnings ~warnings_options >>= fun (_ : bool) ->
  Format.fprintf output "]";
  Ok ()