package goblint
Static analysis framework for C
Install
Dune Dependency
Authors
Maintainers
Sources
goblint-2.5.0.tbz
sha256=452d8491527aea21f2cbb11defcc14ba0daf9fdb6bdb9fc0af73e56eac57b916
sha512=1993cd45c4c7fe124ca6e157f07d17ec50fab5611b270a434ed1b7fb2910aa85a8e6eaaa77dad770430710aafb2f6d676c774dd33942d921f23e2f9854486551
doc/src/goblint.config/jsonSchema.ml.html
Source file jsonSchema.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 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186
(** JSON schema validation. *) module JS = Json_schema.Make (Json_repr.Yojson) module JE = Json_encoding.Make (Json_repr.Yojson) module JQ = Json_query.Make (Json_repr.Yojson) (* copied & modified from json_encoding.ml *) let unexpected kind expected = let kind = match Json_repr.from_yojson kind with | `O [] -> "empty object" | `A [] -> "empty array" | `O _ -> "object" | `A _ -> "array" | `Null -> "null" | `String _ -> "string" | `Float _ -> "number" | `Bool _ -> "boolean" in Json_encoding.Cannot_destruct ([], Json_encoding.Unexpected (kind, expected)) let schema_to_yojson schema = JS.to_json schema let schema_of_yojson json = JS.of_json json let erase: type t. t Json_encoding.encoding -> unit Json_encoding.encoding = fun encoding -> Json_encoding.conv (fun _ -> failwith "erase construct") (fun _ -> ()) encoding let rec encoding_of_schema_element (top: unit Json_encoding.encoding) (schema_element: Json_schema.element): unit Json_encoding.encoding = let open Json_encoding in match schema_element.kind with | Any -> unit | String string_specs -> begin match schema_element.enum with | None -> erase string | Some enum -> enum |> List.map (fun value -> match Json_repr.any_to_repr (module Json_repr.Yojson) value with | `String value -> (value, ()) | _ -> failwith "encoding_of_schema_element: string_enum" ) |> string_enum end | Boolean -> erase bool | Integer numeric_specs -> erase int | Monomorphic_array (el, array_specs) -> erase @@ array (encoding_of_schema_element top el) | Id_ref "" -> top | Object object_specs -> let properties_encoding = List.fold_left (fun acc (name, element, required, _) -> let field = if required then req name (encoding_of_schema_element top element) else dft name (encoding_of_schema_element top element) () in erase @@ merge_objs acc (obj1 field) ) empty object_specs.properties in begin match object_specs.additional_properties with | Some additional_properties -> let additional_encoding = encoding_of_schema_element top additional_properties in JE.custom (fun _ -> failwith "erase construct") (function | `Assoc fields -> let is_properties_field (name, _) = List.exists (fun (name', _, _, _) -> name = name') object_specs.properties in let (properties_fields, additional_fields) = List.partition is_properties_field fields in JE.destruct properties_encoding (`Assoc properties_fields); List.iter (fun (name, value) -> try JE.destruct additional_encoding value with Cannot_destruct (path, err) -> raise (Cannot_destruct (`Field name :: path, err)) ) additional_fields | j -> raise (unexpected j "object") ) ~schema:(Json_schema.create schema_element) | None -> properties_encoding end | _ -> failwith (Format.asprintf "encoding_of_schema_element: %a" Json_schema.pp (Json_schema.create schema_element)) let encoding_of_schema (schema: Json_schema.schema): unit Json_encoding.encoding = let root = Json_schema.root schema in Json_encoding.mu "" (fun top -> encoding_of_schema_element top root) open Json_schema let rec element_defaults ?additional_field (element: element): Yojson.Safe.t = match element.default with | Some default -> Json_repr.any_to_repr (module Json_repr.Yojson) default | None -> begin match element.kind with | Object object_specs -> let additional = match additional_field, object_specs.additional_properties with | Some additional_field, Some additional_properties -> (* create additional field with the additionalProperties default value for lookup in GobConfig *) [(additional_field, element_defaults ~additional_field additional_properties)] | _, _ -> [] in `Assoc (additional @ List.map (fun (name, field_element, _, _) -> (name, element_defaults ?additional_field field_element) ) object_specs.properties) | _ -> Logs.Format.error "%a" Json_schema.pp (create element); failwith "element_defaults" end let schema_defaults ?additional_field (schema: schema): Yojson.Safe.t = element_defaults ?additional_field (root schema) let create_schema element = create element let rec element_require_all (element: element): element = let kind' = match element.kind with | String _ | Boolean | Id_ref _ | Integer _ | Number _ -> element.kind | Monomorphic_array (element_element, array_specs) -> let array_specs' = { array_specs with additional_items = Option.map element_require_all array_specs.additional_items; } in Monomorphic_array (element_require_all element_element, array_specs') | Object object_specs -> let properties' = List.map (fun (name, field_element, required, unknown) -> (name, element_require_all field_element, true, unknown) (* change required to true *) ) object_specs.properties in Object { object_specs with properties = properties' } | _ -> Logs.Format.error "%a" Json_schema.pp (create element); failwith "element_require_all" in { element with kind = kind' } let schema_require_all (schema: schema): schema = create_schema (element_require_all (root schema)) module type Schema = sig val schema: schema end module Validator (Schema: Schema) = struct let schema_encoding = encoding_of_schema Schema.schema (** @raise Json_encoding.Cannot_destruct if invalid. *) let validate_exn json = JE.destruct schema_encoding json (* TODO: bool-returning validate? *) end let () = Printexc.register_printer (function | Json_encoding.Unexpected _ | Json_encoding.No_case_matched _ | Json_encoding.Bad_array_size _ | Json_encoding.Missing_field _ | Json_encoding.Unexpected_field _ | Json_encoding.Bad_schema _ | Json_encoding.Cannot_destruct _ as exn -> let msg = Format.asprintf "Json_encoding: %a" (Json_encoding.print_error ?print_unknown:None) exn in Some msg | Json_schema.Cannot_parse _ | Json_schema.Dangling_reference _ | Json_schema.Bad_reference _ | Json_schema.Unexpected _ | Json_schema.Duplicate_definition _ as exn -> let msg = Format.asprintf "Json_schema: %a" (Json_encoding.print_error ?print_unknown:None) exn in Some msg | Json_query.Illegal_pointer_notation _ | Json_query.Unsupported_path_item _ | Json_query.Cannot_merge _ as exn -> let msg = Format.asprintf "Json_query: %a" (Json_encoding.print_error ?print_unknown:None) exn in Some msg | _ -> None (* for other exceptions *) )
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>