Something went wrong. Try again.
objective categorical abstract machine language personal data server
Something went wrong. Try again.
11 kB · 417 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418(* parse lexicon json files into lexicon_types *)
open Lexicon_types
let get_string_opt key json = match json with | `Assoc pairs -> ( match List.assoc_opt key pairs with Some (`String s) -> Some s | _ -> None ) | _ -> None
let get_string key json = match get_string_opt key json with | Some s -> s | None -> failwith ("missing required string field: " ^ key)
let get_int_opt key json = match json with | `Assoc pairs -> ( match List.assoc_opt key pairs with Some (`Int i) -> Some i | _ -> None ) | _ -> None
let get_int key json = match get_int_opt key json with | Some i -> i | None -> failwith ("missing required int field: " ^ key)
let get_bool_opt key json = match json with | `Assoc pairs -> ( match List.assoc_opt key pairs with Some (`Bool b) -> Some b | _ -> None ) | _ -> None
let get_list_opt key json = match json with | `Assoc pairs -> ( match List.assoc_opt key pairs with Some (`List l) -> Some l | _ -> None ) | _ -> None
let get_string_list_opt key json = match get_list_opt key json with | Some l -> Some (List.filter_map (function `String s -> Some s | _ -> None) l) | None -> None
let get_int_list_opt key json = match get_list_opt key json with | Some l -> Some (List.filter_map (function `Int i -> Some i | _ -> None) l) | None -> None
let get_assoc key json = match json with | `Assoc pairs -> ( match List.assoc_opt key pairs with | Some (`Assoc _ as a) -> Some a | _ -> None ) | _ -> None
(* parse type definition from json *)let rec parse_type_def json : type_def = let type_str = get_string "type" json in match type_str with | "string" -> String { format= get_string_opt "format" json ; min_length= get_int_opt "minLength" json ; max_length= get_int_opt "maxLength" json ; min_graphemes= get_int_opt "minGraphemes" json ; max_graphemes= get_int_opt "maxGraphemes" json ; known_values= get_string_list_opt "knownValues" json ; enum= get_string_list_opt "enum" json ; const= get_string_opt "const" json ; default= get_string_opt "default" json ; description= get_string_opt "description" json } | "integer" -> Integer { minimum= get_int_opt "minimum" json ; maximum= get_int_opt "maximum" json ; enum= get_int_list_opt "enum" json ; const= get_int_opt "const" json ; default= get_int_opt "default" json ; description= get_string_opt "description" json } | "boolean" -> Boolean { const= get_bool_opt "const" json ; default= get_bool_opt "default" json ; description= get_string_opt "description" json } | "bytes" -> Bytes { min_length= get_int_opt "minLength" json ; max_length= get_int_opt "maxLength" json ; description= get_string_opt "description" json } | "blob" -> Blob { accept= get_string_list_opt "accept" json ; max_size= get_int_opt "maxSize" json ; description= get_string_opt "description" json } | "cid-link" -> CidLink {description= get_string_opt "description" json} | "array" -> let items_json = match get_assoc "items" json with | Some j -> j | None -> failwith "array type missing items" in Array { items= parse_type_def items_json ; min_length= get_int_opt "minLength" json ; max_length= get_int_opt "maxLength" json ; description= get_string_opt "description" json } | "object" -> Object (parse_object_spec json) | "ref" -> Ref { ref_= get_string "ref" json ; description= get_string_opt "description" json } | "union" -> Union { refs= ( match get_string_list_opt "refs" json with | Some l -> l | None -> [] ) ; closed= get_bool_opt "closed" json ; description= get_string_opt "description" json } | "token" -> Token {description= get_string_opt "description" json} | "unknown" -> Unknown {description= get_string_opt "description" json} | "query" -> Query (parse_query_spec json) | "procedure" -> Procedure (parse_procedure_spec json) | "subscription" -> Subscription (parse_subscription_spec json) | "record" -> Record (parse_record_spec json) | "permission-set" -> PermissionSet (parse_permission_set_spec json) | t -> failwith ("unknown type: " ^ t)
and parse_object_spec json : object_spec = let properties = match get_assoc "properties" json with | Some (`Assoc pairs) -> List.map (fun (name, prop_json) -> let type_def = parse_type_def prop_json in let description = get_string_opt "description" prop_json in (name, {type_def; description}) ) pairs | _ -> [] in { properties ; required= get_string_list_opt "required" json ; nullable= get_string_list_opt "nullable" json ; description= get_string_opt "description" json }
and parse_params_spec json : params_spec = let properties = match get_assoc "properties" json with | Some (`Assoc pairs) -> List.map (fun (name, prop_json) -> let type_def = parse_type_def prop_json in let description = get_string_opt "description" prop_json in (name, {type_def; description}) ) pairs | _ -> [] in { properties ; required= get_string_list_opt "required" json ; description= get_string_opt "description" json }
and parse_body_def json : body_def = { encoding= get_string "encoding" json ; schema= ( match get_assoc "schema" json with | Some j -> Some (parse_type_def j) | None -> None ) ; description= get_string_opt "description" json }
and parse_error_def json : error_def = {name= get_string "name" json; description= get_string_opt "description" json}
and parse_query_spec json : query_spec = let parameters = match get_assoc "parameters" json with | Some j -> Some (parse_params_spec j) | None -> None in let output = match get_assoc "output" json with | Some j -> Some (parse_body_def j) | None -> None in let errors = match get_list_opt "errors" json with | Some l -> Some (List.map (function | `Assoc _ as j -> parse_error_def j | _ -> failwith "invalid error def" ) l ) | None -> None in {parameters; output; errors; description= get_string_opt "description" json}
and parse_procedure_spec json : procedure_spec = let parameters = match get_assoc "parameters" json with | Some j -> Some (parse_params_spec j) | None -> None in let input = match get_assoc "input" json with | Some j -> Some (parse_body_def j) | None -> None in let output = match get_assoc "output" json with | Some j -> Some (parse_body_def j) | None -> None in let errors = match get_list_opt "errors" json with | Some l -> Some (List.map (function | `Assoc _ as j -> parse_error_def j | _ -> failwith "invalid error def" ) l ) | None -> None in { parameters ; input ; output ; errors ; description= get_string_opt "description" json }
and parse_subscription_spec json : subscription_spec = let parameters = match get_assoc "parameters" json with | Some j -> Some (parse_params_spec j) | None -> None in let message = match get_assoc "message" json with | Some j -> Some (parse_body_def j) | None -> None in let errors = match get_list_opt "errors" json with | Some l -> Some (List.map (function | `Assoc _ as j -> parse_error_def j | _ -> failwith "invalid error def" ) l ) | None -> None in {parameters; message; errors; description= get_string_opt "description" json}
and parse_record_spec json : record_spec = let key = get_string "key" json in let record_json = match get_assoc "record" json with | Some j -> j | None -> failwith "record type missing record field" in { key ; record= parse_object_spec record_json ; description= get_string_opt "description" json }
and parse_permission json : lex_permission = let resource = get_string "resource" json in let extra = match json with | `Assoc pairs -> List.filter (fun (k, _) -> k <> "resource") pairs | _ -> [] in {resource; extra}
and parse_lang_map key json : (string * string) list option = match json with | `Assoc pairs -> let prefix = key ^ ":" in let lang_pairs = List.filter_map (fun (k, v) -> if String.starts_with ~prefix k then let lang = String.sub k (String.length prefix) (String.length k - String.length prefix) in match v with `String s -> Some (lang, s) | _ -> None else None ) pairs in if lang_pairs = [] then None else Some lang_pairs | _ -> None
and parse_permission_set_spec json : permission_set_spec = let permissions = match get_list_opt "permissions" json with | Some l -> List.map (function | `Assoc _ as j -> parse_permission j | _ -> failwith "invalid permission" ) l | None -> [] in { title= get_string_opt "title" json ; title_lang= parse_lang_map "title" json ; detail= get_string_opt "detail" json ; detail_lang= parse_lang_map "detail" json ; permissions ; description= get_string_opt "description" json }
(* parse complete lexicon document *)let parse_lexicon_doc json : lexicon_doc = let lexicon = get_int "lexicon" json in let id = get_string "id" json in let revision = get_int_opt "revision" json in let description = get_string_opt "description" json in let defs = match get_assoc "defs" json with | Some (`Assoc pairs) -> List.map (fun (name, def_json) -> {name; type_def= parse_type_def def_json}) pairs | _ -> [] in {lexicon; id; revision; description; defs}
(* parse lexicon file *)let parse_file path : parse_result = try let json = Yojson.Safe.from_file path in Ok (parse_lexicon_doc json) with | Yojson.Json_error e -> Error ("JSON parse error: " ^ e) | Failure e -> Error ("Parse error: " ^ e) | e -> Error ("Unexpected error: " ^ Printexc.to_string e)
(* parse json string *)let parse_string content : parse_result = try let json = Yojson.Safe.from_string content in Ok (parse_lexicon_doc json) with | Yojson.Json_error e -> Error ("JSON parse error: " ^ e) | Failure e -> Error ("Parse error: " ^ e) | e -> Error ("Unexpected error: " ^ Printexc.to_string e)