diff options
Diffstat (limited to 'lib/catalog.ml')
| -rw-r--r-- | lib/catalog.ml | 34 |
1 files changed, 31 insertions, 3 deletions
diff --git a/lib/catalog.ml b/lib/catalog.ml index be54375..74fe3de 100644 --- a/lib/catalog.ml +++ b/lib/catalog.ml @@ -33,13 +33,39 @@ module Make (S : Management.Physical.S with type error = string) = struct if Atomic.compare_and_set catalog.multigroups expected updated then Ok () else Error "Concurrent multigroup map update detected" + let get_string_attr attr (t : Tuple.materialized) = + Option.map + (fun a -> (Obj.magic a.Attribute.value : string)) + (Tuple.AttributeMap.find_opt attr t.attributes) + + (** Dynlink every library recorded in public:loaded_library. No-op on a fresh + DB; effective when loading a previously persisted multigroup. *) + let hydrate_prl_libraries storage (db : Management.Database.t) = + match + Management.Database.get_relation db Prelude.Catalog.loaded_library_rel_name + with + | None -> () + | Some rel -> + let hashes = + match rel.Relation.tree with None -> [] | Some t -> Merkle.keys t + in + (match Manip.load_tuples storage hashes with + | Error _ -> () + | Ok tuples -> + List.iter + (fun t -> + match get_string_attr "path" t with + | None -> () + | Some path -> ignore (Prl.Runtime.load_library path)) + tuples) + (** Swallow errors: a missing prelude relation is non-fatal. *) let register_prelude_relation storage db (rel : Relation.t) = match Manip.create_immutable_relation storage db ~name:rel.name ~schema:rel.schema ~generator:(Option.get rel.generator) ~membership_criteria:rel.membership_criteria - ~cardinality:rel.cardinality + ~cardinality:rel.cardinality ~producer:None with | Ok (new_db, _) -> new_db | Error e -> @@ -47,10 +73,12 @@ module Make (S : Management.Physical.S with type error = string) = struct rel.name (Sexplib.Sexp.to_string (Error.sexp_of_error e)); db - (** Create DB + seed catalog + fold in [prelude_relations]. *) + (** Create DB + seed catalog + fold in [prelude_relations] + hydrate PRL. *) let bootstrap_multigroup storage ~prelude_relations ~name = let* db = Manip.create_database storage ~name |> map_error in - Ok (List.fold_left (register_prelude_relation storage) db prelude_relations) + let db = List.fold_left (register_prelude_relation storage) db prelude_relations in + hydrate_prl_libraries storage db; + Ok db (** Create additional catalog relations beyond the base six. Used to seed [public:multigroup] into the sakura multigroup only. *) |