1:- module(jsonrpc_client, [
    2    jsonrpc_connect/2,
    3    jsonrpc_disconnect/1,
    4    with_connection/3,
    5
    6    call_method/3,
    7    call_method/4,
    8    notify_method/3,
    9
   10    expect_error/2
   11  ]).   12
   13:- use_module(library(uuid)).   14
   15:- use_module(library(log4p)).   16
   17:- use_module('./protocol').   18:- use_module('./connectors').   19
   20jsonrpc_connect(ServerInfo,Connection) :-
   21  connect_to_server(ServerInfo, Connection).
   22
   23jsonrpc_disconnect(Connection) :-
   24  close_connection(Connection).
   25
   26with_connection(ServerInfo,Connection,Goal) :-
   27  setup_call_cleanup(
   28    jsonrpc_connect(ServerInfo,Connection),
   29    Goal,
   30    jsonrpc_disconnect(Connection)
   31    ).
   32
   33call_method(Connection, Method, Params, Result) :-
   34  connection_stream_pair(Connection,StreamPair),
   35  stream_pair(StreamPair,In,Out),
   36  uuid(Id),
   37  Request = _{jsonrpc: "2.0", id : Id, method: Method, params: Params},
   38  write_message(Out, Request),
   39  debug('Sent request: %w',[Request]),
   40  flush_output(Out),
   41  read_message(In, Response),
   42  debug('Received response: %w', [Response]),
   43  ( _ = Response.get(result) ->
   44    Result = Response.result ;
   45    throw(jsonrpc_error(Response.error)) ),
   46  !.
   47
   48% Call method but with no params
   49call_method(Connection, Method, Result) :-
   50  connection_stream_pair(Connection,StreamPair),
   51  stream_pair(StreamPair,In,Out),
   52  uuid(Id),
   53  Request = _{jsonrpc: "2.0", id : Id, method: Method},
   54  write_message(Out, Request),
   55  debug('Sent request: %w',[Request]),
   56  flush_output(Out),
   57  read_message(In, Response),
   58  debug('Received response: %w', [Response]),
   59  ( _ = Response.get(result) ->
   60    Result = Response.result ;
   61    throw(jsonrpc_error(Response.error)) ),
   62  !.
   63
   64notify_method(Connection, Method, Params) :-
   65  connection_stream_pair(Connection,StreamPair),
   66  stream_pair(StreamPair,_In,Out),
   67  Request = _{jsonrpc: "2.0", method: Method, params: Params},
   68  write_message(Out, Request),
   69  !.
   70
   71% 
   72% Helpers, usually for testing
   73% 
   74
   75expect_error(Goal, ExpectedError) :-
   76  catch(
   77    (Goal, fail),
   78    ActualError,
   79    true
   80    ),
   81  ( ExpectedError = ActualError
   82    -> true
   83    ; ( 
   84      warn("Expected error %q, ecnountered %q",[ExpectedError, ActualError]), 
   85      fail
   86      )
   87    )