zmq_rpc

array_to_prob_seq([], _, []) :- !.

array_to_prob_seq([H|T], N, [(int(N),FT)|RT]) :-
    !,
    result_to_freetype(H, FT),
    N1 is N+1,
    array_to_prob_seq(T, N1, RT).

extract_error_result(E, string(Res)) :-
    (E=json(ErrorObject) -> true ; ErrorObject=[]),
    (member(code=number(Code), ErrorObject) -> true ; Code = -1),
    (member(message=string(Message), ErrorObject) -> true ; Message = 'N/A'),
    ajoin(['error ', Code, ': ', Message], Res).

extract_json_rpc_result(json(JsonObject), Id, ResAst) :-
    member(jsonrpc=string('2.0'), JsonObject), !,
    member(id=JsonId, JsonObject), !, (number(Id) -> JsonId = number(Id) ; JsonId = string(Id)),
    (member(error=E, JsonObject)
    -> extract_error_result(E, WrappedRes), ResAst = freeval('RpcResult', 'RpcError', WrappedRes)
    ; extract_success_result(JsonObject, WrappedRes), ResAst = freeval('RpcResult', 'RpcSuccess', WrappedRes)
).

extract_success_result(JsonObject, ResAst) :-
    member(result=Res, JsonObject), !,
    result_to_freetype(Res, ResAst).

foreign(zmq_rpc_init_impl, zmq_rpc_init_impl(+string, [-address])).

foreign(zmq_rpc_destroy_impl, zmq_rpc_destroy_impl(+address)).

foreign(zmq_rpc_send_str_impl, zmq_rpc_send_str_impl(+address, +codes)).

foreign(zmq_rpc_receive_str_impl, zmq_rpc_receive_str_impl(+address, [-codes])).

foreign_resource(zmq_rpc, [zmq_rpc_init_impl, zmq_rpc_destroy_impl, zmq_rpc_send_str_impl, zmq_rpc_receive_str_impl]).

init_zmq_rpc :-
    (loaded -> true
    ; assertz(loaded),
    safe_load_foreign_resource(zmq_rpc, zmq_rpc)
).

next_rpc_request_id(Id) :-
    (last_rpc_request_id(Last) -> Id is Last+1 ; Id=1),
    retractall(last_rpc_request_id(_)),
    assertz(last_rpc_request_id(Id)).

object_to_prob_fun([], []) :- !.

object_to_prob_fun([K=H|T], [(string(K),FT)|RT]) :-
    !,
    result_to_freetype(H, FT),
    object_to_prob_fun(T, RT).

prob_fun_to_object([], []) :- !.

prob_fun_to_object([(string(K),H)|T], [K=R|RT]) :-
    !,
    write_json_rpc_param_value(H, R),
    prob_fun_to_object(T, RT).

prob_seq_to_array([], []) :- !.

prob_seq_to_array([(_,H)|T], [R|RT]) :-
    !,
    write_json_rpc_param_value(H, R),
    prob_seq_to_array(T, RT).

result_to_freetype(@(null), ResAst) :-
    !,
    ResAst = freeval('RpcValue', 'RpcNull', term('RpcNull')).

result_to_freetype(@(true), ResAst) :-
    !,
    ResAst = freeval('RpcValue', 'RpcBoolean', pred_true).

result_to_freetype(@(false), ResAst) :-
    !,
    ResAst = freeval('RpcValue', 'RpcBoolean', pred_false).

result_to_freetype(number(Res), ResAst) :-
    integer(Res), !,
    ResAst = freeval('RpcValue', 'RpcInteger', int(Res)).

result_to_freetype(number(Res), ResAst) :-
    float(Res), !,
    ResAst = freeval('RpcValue', 'RpcFloat', term(floating(Res))).

result_to_freetype(string(S), ResAst) :-
    !,
    ResAst = freeval('RpcValue', 'RpcString', string(S)).

result_to_freetype(array(A), ResAst) :-
    !,
    array_to_prob_seq(A, 1, Seq),
    convert_to_avl(Seq, R),
    ResAst = freeval('RpcValue', 'RpcArray', R).

result_to_freetype(json(O), ResAst) :-
    !,
    object_to_prob_fun(O, Fun),
    convert_to_avl(Fun, R),
    ResAst = freeval('RpcValue', 'RpcObject', R).

result_to_freetype(X, _) :- !, add_error(zmq_rpc, 'cannot convert parameter from json', X), fail.

write_json_rpc(Method, Params, Id, Json) :-
    write_json_rpc_params(Params, JsonParams),
    (number(Id) -> JsonId = number(Id) ; JsonId = string(Id)),
    Json = json([jsonrpc=string('2.0'), method=string(Method), params=json(JsonParams), id=JsonId]).

write_json_rpc_param_value(freeval('RpcValue', 'RpcNull', term('RpcNull')), @(null)) :- !.

write_json_rpc_param_value(freeval('RpcValue', 'RpcBoolean', pred_true), @(true)) :- !.

write_json_rpc_param_value(freeval('RpcValue', 'RpcBoolean', pred_false), @(false)) :- !.

write_json_rpc_param_value(freeval('RpcValue', 'RpcInteger', int(V)), number(V)) :- !.

write_json_rpc_param_value(freeval('RpcValue', 'RpcFloat', term(floating(V))), number(V)) :- !.

write_json_rpc_param_value(freeval('RpcValue', 'RpcString', string(V)), string(V)) :- !.

write_json_rpc_param_value(freeval('RpcValue', 'RpcArray', S), array(A)) :-
    !,
    expand_custom_set_to_list(S, Seq),
    sort(Seq, Sorted), % this sorts by seq-index and thus preserves iteration order
    prob_seq_to_array(Sorted, A).

write_json_rpc_param_value(freeval('RpcValue', 'RpcObject', F), json(O)) :-
    !,
    expand_custom_set_to_list(F, Fun),
    prob_fun_to_object(Fun, O).

write_json_rpc_param_value(X, _) :- !, add_error(zmq_rpc, 'cannot convert parameter to json', X), fail.

write_json_rpc_params([], []) :- !.

write_json_rpc_params([(string(K), V)|T], [K=JsonValue|JsonT]) :-
    !,
    write_json_rpc_param_value(V, JsonValue),
    write_json_rpc_params(T, JsonT).

zmq_rpc_destroy(int(Socket)) :-
    zmq_rpc_destroy_aux(Socket).

zmq_rpc_destroy_all :-
    (open_socket(Socket) -> zmq_rpc_destroy_aux(Socket), zmq_rpc_destroy_all ; true).

zmq_rpc_destroy_aux(Socket) :-
    integer(Socket),
    init_zmq_rpc,
    open_socket(Socket),
    zmq_rpc_destroy_impl(Socket),
    retractall(open_socket(Socket)).

zmq_rpc_init(string(Endpoint), int(Res)) :-
    atom(Endpoint),
    init_zmq_rpc,
    zmq_rpc_init_impl(Endpoint, Res),
    integer(Res),
    assertz(open_socket(Res)).

zmq_rpc_send(int(Socket), string(Name), ArgsAst, ResAst) :-
    integer(Socket),
    atom(Name),
    expand_custom_set_to_list(ArgsAst, Args),
    ground(Args),
    next_rpc_request_id(Id),
    write_json_rpc(Name, Args, Id, JsonRpcReq),
    json_write(JsonRpcReq, ReqCodes),
    init_zmq_rpc,
    zmq_rpc_send_str_impl(Socket, ReqCodes),
    zmq_rpc_receive_str_impl(Socket, ResCodes),
    json_parse(ResCodes, ResJson),
    extract_json_rpc_result(ResJson, Id, ResAst).