Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file json_schema.ml
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251(* This file is part of the Catala compiler, a specification language for tax
and social benefits computation rules. Copyright (C) 2020 Inria,
contributors: Emile Rolley <emile.rolley@tuta.io>.
Licensed under the Apache License, Version 2.0 (the "License"); you may not
use this file except in compliance with the License. You may obtain a copy of
the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
License for the specific language governing permissions and limitations under
the License. *)openCatala_utilsopenShared_astopenLcalc.To_ocamlmoduleD=Dcalc.Ast(** Contains all format functions used to format a Lcalc Catala program
representation to a JSON schema describing the corresponding web form. *)moduleTo_json=structletto_camel_case(s:string):string=String.split_on_char'_'s|>(function|hd::tl->hd::List.mapString.capitalize_asciitl|l->l)|>String.concat""letformat_struct_field_name_camel_case(fmt:Format.formatter)(v:StructField.t):unit=lets=Format.asprintf"%a"StructField.formatv|>String.to_ascii|>String.to_snake_case|>avoid_keywords|>to_camel_caseinFormat.fprintffmt"%s"sletfmt_tlitfmt(tlit:typ_lit)=matchtlitwith|TInt|TRat->Format.fprintffmt"\"type\": \"number\",@\n\"default\": 0"|TMoney->Format.fprintffmt"\"type\": \"number\",@\n\"minimum\": 0,@\n\"default\": 0"|TBool->Format.fprintffmt"\"type\": \"boolean\",@\n\"default\": false"|TDate->Format.fprintffmt"\"type\": \"string\",@\n\"format\": \"date\""|TDuration->failwith"TODO: tlit duration"|TUnit->(* NOTE(@EmileRolley): we previously used the "null" type for unit, but it
is not working properly so we simply decided to remove it. *)()letrecfmt_typefmt(typ:typ)=matchMark.removetypwith|TLittlit->fmt_tlitfmttlit|TStructsname->Format.fprintffmt"\"$ref\": \"#/definitions/%a\""format_struct_namesname|TEnumename->Format.fprintffmt"\"$ref\": \"#/definitions/%a\""format_enum_nameename|TArrayt->Format.fprintffmt"\"type\": \"array\",@\n\
\"default\": [],@\n\
@[<hov 2>\"items\": {@\n\
%a@]@\n\
}"fmt_typet|_->()letfmt_struct_properties(ctx:decl_ctx)(fmt:Format.formatter)(sname:StructName.t)=letfields=StructName.Map.findsnamectx.ctx_structsinFormat.pp_print_list~pp_sep:(funfmt()->Format.fprintffmt",@\n")(funfmt(field_name,field_type)->Format.fprintffmt"@[<hov 2>\"%a\": {@\n%a@]@\n}"format_struct_field_name_camel_casefield_namefmt_typefield_type)fmt(StructField.Map.bindingsfields)letfmt_definitions(ctx:decl_ctx)(fmt:Format.formatter)((_scope_name,scope_body):ScopeName.t*'escope_body)=letget_namet=matchMark.removetwith|TStructsname->Format.asprintf"%a"format_struct_namesname|TEnumename->Format.asprintf"%a"format_enum_nameename|_->failwith"unreachable: only structs and enums are collected."inletreccollect_required_type_defs_from_scope_input(input_struct:StructName.t):typlist=letreccollect(acc:typlist)(t:typ):typlist=matchMark.removetwith|TStructs->(* Scope's input is a struct. *)(t::acc)@collect_required_type_defs_from_scope_inputs|TEnume->List.fold_leftcollect(t::acc)(EnumConstructor.Map.values(EnumName.Map.findectx.ctx_enums))|TArrayt->collectacct|_->accinStructName.Map.findinput_structctx.ctx_structs|>StructField.Map.values|>List.fold_left(funaccfield_typ->collectaccfield_typ)[]|>List.sort_uniq(funtt'->String.compare(get_namet)(get_namet'))inletfmt_enum_propertiesfmtename=letenum_def=EnumName.Map.findenamectx.ctx_enumsinFormat.fprintffmt"@[<hov 2>\"kind\": {@\n\
\"type\": \"string\",@\n\
@[<hov 2>\"anyOf\": [@\n\
%a@]@\n\
]@]@\n\
}@\n\
},@\n\
@[<hov 2>\"allOf\": [@\n\
%a@]@\n\
]@]@\n\
}"(Format.pp_print_list~pp_sep:(funfmt()->Format.fprintffmt",@\n")(funfmtenum_cons->Format.fprintffmt"@[<hov 2>{@\n\"type\": \"string\",@\n\"enum\": [\"%a\"]@]@\n}"format_enum_cons_nameenum_cons))(EnumConstructor.Map.keysenum_def)(Format.pp_print_list~pp_sep:(funfmt()->Format.fprintffmt",@\n")(funfmt(enum_cons,payload_type)->Format.fprintffmt"@[<hov 2>{@\n\
@[<hov 2>\"if\": {@\n\
@[<hov 2>\"properties\": {@\n\
@[<hov 2>\"kind\": {@\n\
\"const\": \"%a\"@]@\n\
}@]@\n\
}@]@\n\
},@\n\
@[<hov 2>\"then\": {@\n\
@[<hov 2>\"properties\": {@\n\
@[<hov 2>\"payload\": {@\n\
%a@]@\n\
}@]@\n\
}@]@\n\
}@]@\n\
}"format_enum_cons_nameenum_consfmt_typepayload_type))(EnumConstructor.Map.bindingsenum_def)inFormat.fprintffmt"@\n%a"(Format.pp_print_list~pp_sep:(funfmt()->Format.fprintffmt",@\n")(funfmttyp->matchMark.removetypwith|TStructsname->Format.fprintffmt"@[<hov 2>\"%a\": {@\n\
\"type\": \"object\",@\n\
@[<hov 2>\"properties\": {@\n\
%a@]@\n\
}@]@\n\
}"format_struct_namesname(fmt_struct_propertiesctx)sname|TEnumename->Format.fprintffmt"@[<hov 2>\"%a\": {@\n\
\"type\": \"object\",@\n\
@[<hov 2>\"properties\": {@\n\
%a@]@]@\n"format_enum_nameenamefmt_enum_propertiesename|_->()))(collect_required_type_defs_from_scope_inputscope_body.scope_body_input_struct)letformat_program(fmt:Format.formatter)(scope:ScopeName.t)(prgm:'mLcalc.Ast.program)=letscope_body=Program.get_scope_bodyprgmscopeinFormat.fprintffmt"{@[<hov 2>@\n\
\"type\": \"object\",@\n\
\"@[<hov 2>definitions\": {%a@]@\n\
},@\n\
\"@[<hov 2>properties\": {@\n\
%a@]@\n\
}@]@\n\
}"(fmt_definitionsprgm.decl_ctx)(scope,scope_body)(fmt_struct_propertiesprgm.decl_ctx)scope_body.scope_body_input_structendletrunincludesoutputoptimizecheck_invariantsavoid_exceptionsclosure_conversionmonomorphize_typesex_scopeoptions=letprg,_=Driver.Passes.lcalcoptions~includes~optimize~check_invariants~avoid_exceptions~closure_conversion~typed:Expr.typed~monomorphize_typesinletoutput_file,with_output=Driver.Commands.get_output_formatoptions~ext:"_schema.json"outputinwith_output@@funfmt->letscope_uid=Driver.Commands.get_scope_uidprg.decl_ctxex_scopeinMessage.debug"Writing JSON schema corresponding to the scope '%a' to the file %s..."ScopeName.formatscope_uid(Option.value~default:"stdout"output_file);To_json.format_programfmtscope_uidprgletterm=letopenCmdliner.Terminconstrun$Cli.Flags.include_dirs$Cli.Flags.output$Cli.Flags.optimize$Cli.Flags.check_invariants$Cli.Flags.avoid_exceptions$Cli.Flags.closure_conversion$Cli.Flags.monomorphize_types$Cli.Flags.ex_scopelet()=Driver.Plugin.register"json_schema"term~doc:"Catala plugin for generating {{:https://json-schema.org} JSON schemas} \
used to build forms for the Catala website."