-let paths_and_uris_of_obj uri status =
- let basedir = get_string_option status "basedir" ^ "/xml" in
- let innertypesuri = UriManager.innertypesuri_of_uri uri in
- let bodyuri = UriManager.bodyuri_of_uri uri in
- let univgraphuri = UriManager.univgraphuri_of_uri uri in
- let innertypesfilename = Str.replace_first (Str.regexp "^cic:") ""
- (UriManager.string_of_uri innertypesuri) ^ ".xml.gz" in
- let innertypespath = basedir ^ "/" ^ innertypesfilename in
- let xmlfilename = Str.replace_first (Str.regexp "^cic:/") ""
- (UriManager.string_of_uri uri) ^ ".xml.gz" in
- let xmlpath = basedir ^ "/" ^ xmlfilename in
- let xmlbodyfilename = Str.replace_first (Str.regexp "^cic:/") ""
- (UriManager.string_of_uri uri) ^ ".body.xml.gz" in
- let xmlbodypath = basedir ^ "/" ^ xmlbodyfilename in
- let xmlunivgraphfilename = Str.replace_first (Str.regexp "^cic:/") ""
- (UriManager.string_of_uri univgraphuri) ^ ".xml.gz" in
- let xmlunivgraphpath = basedir ^ "/" ^ xmlunivgraphfilename in
- xmlpath, xmlbodypath, innertypespath, bodyuri, innertypesuri,
- xmlunivgraphpath, univgraphuri
-
-let save_object_to_disk status uri obj ugraph univlist =
- let ensure_path_exists path =
- let dir = Filename.dirname path in
- HExtlib.mkdir dir
- in
- (* generate annobj, ids_to_inner_sorts and ids_to_inner_types *)
- let annobj = Cic2acic.plain_acic_object_of_cic_object obj in
- (* prepare XML *)
- let xml, bodyxml =
- Cic2Xml.print_object
- uri ?ids_to_inner_sorts:None ~ask_dtd_to_the_getter:false annobj
- in
- let xmlpath, xmlbodypath, innertypespath, bodyuri, innertypesuri,
- xmlunivgraphpath, univgraphuri =
- paths_and_uris_of_obj uri status
- in
- List.iter HExtlib.mkdir (List.map Filename.dirname [xmlpath]);
- (* now write to disk *)
- ensure_path_exists xmlpath;
- Xml.pp ~gzip:true xml (Some xmlpath);
- CicUniv.write_xml_of_ugraph xmlunivgraphpath ugraph univlist;
- (* we return a list of uri,path we registered/created *)
- (uri,xmlpath) ::
- (univgraphuri,xmlunivgraphpath) ::
- (* now the optional body, both write and register *)
- (match bodyxml,bodyuri with
- None,None -> []
- | Some bodyxml,Some bodyuri->
- ensure_path_exists xmlbodypath;
- Xml.pp ~gzip:true bodyxml (Some xmlbodypath);
- [bodyuri, xmlbodypath]
- | _-> assert false)
-
-let typecheck_obj =
- let profiler = HExtlib.profile "add_obj.typecheck_obj" in
- fun uri obj -> profiler.HExtlib.profile (CicTypeChecker.typecheck_obj uri) obj
-
-let index_obj =
- let profiler = HExtlib.profile "add_obj.index_obj" in
- fun ~dbd ~uri ->
- profiler.HExtlib.profile (fun uri -> MetadataDb.index_obj ~dbd ~uri) uri
-