44 lines
1.3 KiB
OCaml
44 lines
1.3 KiB
OCaml
open Printf
|
|
open Sexp
|
|
open Datastructures
|
|
|
|
type factory_t = Sexp.t -> (Sexp.t, Sexp.t) Status.t
|
|
|
|
let classes = ref StringMap.empty
|
|
|
|
let register_class name factory =
|
|
if StringMap.mem name !classes
|
|
then (fprintf stderr "ERROR: Duplicate node class name %s\n%!" name;
|
|
exit 1)
|
|
else classes := StringMap.add name factory !classes
|
|
|
|
let lookup_class name =
|
|
try Some (StringMap.find name !classes)
|
|
with Not_found -> None
|
|
|
|
let factory_handler n sexp =
|
|
match Message.message_of_sexp sexp with
|
|
| Message.Create (Str classname, arg, Str reply_sink, Str reply_name) ->
|
|
let reply =
|
|
match lookup_class classname with
|
|
| Some factory ->
|
|
(match factory arg with
|
|
| Status.Ok info ->
|
|
Log.info "Node create ok"
|
|
[Str classname; arg; Str reply_sink; Str reply_name; info];
|
|
Message.create_ok info
|
|
| Status.Problem explanation ->
|
|
Log.info "Node create failed"
|
|
[Str classname; arg; Str reply_sink; Str reply_name; explanation];
|
|
Message.create_failed (Arr [Str "constructor"; explanation]))
|
|
| None ->
|
|
Log.warn "Node class not found" [Str classname];
|
|
Message.create_failed (Arr [Str "factory"; Str "class-not-found"])
|
|
in
|
|
Node.post_ignore reply_sink (Str reply_name) reply (Str "")
|
|
| m ->
|
|
Util.message_not_understood "factory" m
|
|
|
|
let init () =
|
|
Node.bind_ignore ("factory", Node.make "factory" factory_handler)
|