package goblint

  1. Overview
  2. Docs
package goblint
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file options.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
(** [src/config/options.schema.json] low-level access. *)

open Json_schema

let schema =
  (* JsonSchema.schema_of_yojson (Yojson.Safe.from_file "options.schema.json") *)
  JsonSchema.schema_of_yojson (Yojson.Safe.from_string [%blob "options.schema.json"])

let require_all = JsonSchema.schema_require_all schema

let defaults_additional_field = "__additional__" (* this shouldn't conflict with any actual field *)
let defaults = JsonSchema.schema_defaults ~additional_field:defaults_additional_field schema

let () =
  (* Yojson.Safe.pretty_to_channel (Stdlib.open_out "options.require-all.schema.json") (JsonSchema.schema_to_yojson require_all); *)
  (* Yojson.Safe.pretty_to_channel (Stdlib.open_out "options.defaults.json") defaults; *)
  ()

let rec element_paths (element: element): string list =
  match element.kind with
  | String _
  | Boolean
  | Integer _
  | Number _
  | Monomorphic_array _ ->
    [""]
  | Object object_specs ->
    List.concat_map (fun (name, field_element, _, _) ->
        List.map (fun path -> name ^ "." ^ path) (element_paths field_element)
      ) object_specs.properties
  | _ ->
    Logs.Format.error "%a" Json_schema.pp (create element);
    failwith "element_paths"

let schema_paths (schema: schema): string list =
  element_paths (root schema)
  |> List.map BatString.rchop (* remove trailing '.' *)

let paths = schema_paths schema

let rec element_completions (element: element): (string * string list) list =
  let default_completion () =
    match element.default with
    | Some default ->
      [("", [Yojson.Safe.to_string (Json_repr.any_to_repr (module Json_repr.Yojson) default)])]
    | None ->
      [("", [])]
  in
  match element.kind with
  | Integer _
  | Number _
  | Monomorphic_array _ ->
    default_completion ()
  | Boolean ->
    [("", ["false"; "true"])]
  | String string_specs ->
    begin match element.enum with
      | None ->
        default_completion ()
      | Some enum ->
        let cs = List.map (fun value ->
            match Json_repr.any_to_repr (module Json_repr.Yojson) value with
            | `String value -> value
            | _ -> failwith "element_completions: string_enum"
          ) enum
        in
        [("", cs)]
    end
  | Object object_specs ->
    List.concat_map (fun (name, field_element, _, _) ->
        List.map (fun (path, cs) -> (name ^ "." ^ path, cs)) (element_completions field_element)
      ) object_specs.properties
  | _ ->
    Logs.Format.error "%a" Json_schema.pp (create element);
    failwith "element_completions"

let schema_completions (schema: schema): (string * string list) list =
  element_completions (root schema)
  |> List.map (BatTuple.Tuple2.map1 BatString.rchop) (* remove trailing '.' *)

let completions = schema_completions schema

let rec pp_options ~levels ppf (element: element) =
  match element.kind with
  | String _
  | Boolean
  | Integer _
  | Number _
  | Monomorphic_array _ ->
    (* Format.fprintf ppf "%s: %s (%a)" (Option.get element.title) (Option.get element.description) (Yojson.Safe.pretty_print ~std:false) (Json_repr.any_to_repr (module Json_repr.Yojson) (Option.get element.default)) *)
    (* Yojson screws up box indentation somehow... *)
    Format.fprintf ppf "%s: %s (%s)" (Option.get element.title) (Option.get element.description) (Yojson.Safe.to_string (Json_repr.any_to_repr (module Json_repr.Yojson) (Option.get element.default)))
  | Object object_specs when levels > 0 ->
    let properties = List.filter (fun (name, field_element, _, _) ->
        match field_element.kind with
        | Object _ when levels = 1 -> false (* avoid empty lines with --options *)
        | _ -> true
      ) object_specs.properties
    in
    let pp_property ppf (name, field_element, _, _) =
      Format.fprintf ppf "%a" (pp_options ~levels:(levels - 1)) field_element
    in
    begin match element.title with
      | Some title ->
        Format.fprintf ppf "@[<v 0>%s:@,  @[<v 0>%a@]@]" title (Format.pp_print_list pp_property) properties
      | None ->
        Format.fprintf ppf "@[<v 0>%a@]" (Format.pp_print_list pp_property) properties
    end
  | Object _ ->
    ()
  | _ ->
    failwith "pp_options"

let print_options () =
  Format.printf "%a\n" (pp_options ~levels:1) (root schema) (* nosemgrep: print-not-logging *)

let print_all_options () =
  Format.printf "%a\n" (pp_options ~levels:max_int) (root schema) (* nosemgrep: print-not-logging *)
OCaml

Innovation. Community. Security.

GitHub Discord Twitter Peertube RSS
About
Changelog Releases Industrial Users Academic Users Why OCaml
Ecosystem
Packages Community Events OCaml Planet Jobs
Resources
Install OCaml Get Started Platform Tools Language Manual Standard Library API Books Exercises Papers OCaml Playground Logo
Policies
Carbon Footprint Governance Privacy Code of Conduct