This repository has been archived by the owner on May 22, 2018. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 42
/
rpc.ml
103 lines (88 loc) · 3.11 KB
/
rpc.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
(*
* Copyright (C) 2006-2009 Citrix Systems Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published
* by the Free Software Foundation; version 2.1 only. with the special
* exception on linking described in file LICENSE.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*)
let debug = ref false
let set_debug x = debug := x
let get_debug () = !debug
let lower = String.lowercase
type t =
| Int of int64
| Int32 of int32
| Bool of bool
| Float of float
| String of string
| DateTime of string
| Enum of t list
| Dict of (string * t) list
| Null
exception Runtime_error of string * t
exception Runtime_exception of string * string
open Printf
let map_strings sep fn l = String.concat sep (List.map fn l)
let rec to_string t = match t with
| Int i -> sprintf "I(%Li)" i
| Int32 i -> sprintf "I32(%li)" i
| Bool b -> sprintf "B(%b)" b
| Float f -> sprintf "F(%g)" f
| String s -> sprintf "S(%s)" s
| DateTime d -> sprintf "D(%s)" d
| Enum ts -> sprintf "[%s]" (map_strings ";" to_string ts)
| Dict ts -> sprintf "{%s}" (map_strings ";" (fun (s,t) -> sprintf "%s:%s" s (to_string t)) ts)
| Null -> "N"
let rpc_of_t x = x
let rpc_of_int64 i = Int i
let rpc_of_int32 i = Int (Int64.of_int32 i)
let rpc_of_int i = Int (Int64.of_int i)
let rpc_of_bool b = Bool b
let rpc_of_float f = Float f
let rpc_of_string s = String s
let rpc_of_dateTime d = DateTime d
let rpc_of_unit () = Null
let t_of_rpc x = x
let int64_of_rpc = function
| Int i -> i
| String s -> Int64.of_string s
| _ -> failwith "int64_of_rpc"
let int32_of_rpc = function
| Int i -> Int64.to_int32 i
| String s -> Int32.of_string s
| _ -> failwith "int32_of_rpc"
let int_of_rpc = function
| Int i -> Int64.to_int i
| String s -> int_of_string s
| _ -> failwith "int_of_rpc"
let bool_of_rpc = function Bool b -> b | _ -> failwith "bool_of_rpc"
let float_of_rpc = function
| Float f -> f
| String s -> float_of_string s
| _ -> failwith "float_of_rpc"
let string_of_rpc = function String s -> s | _ -> failwith "string_of_rpc"
let dateTime_of_rpc = function DateTime d -> d | _ -> failwith "dateTime_of_rpc"
let unit_of_rpc = function Null -> () | _ -> failwith "unit_of_rpc"
let lowerfn = function | String s -> String (lower s) | Enum (String s::ss) -> Enum ((String (lower s))::ss) | x -> x
type callback = string list -> t -> unit
type call = {
name: string;
params: t list;
}
let call name params = { name = name; params = params }
let string_of_call call =
sprintf "-> %s(%s)" call.name (String.concat "," (List.map to_string call.params))
type response = {
success: bool;
contents: t;
}
let string_of_response response =
sprintf "<- %s(%s)" (if response.success then "success" else "failure") (to_string response.contents)
let success v = { success = true; contents = v }
let failure v = { success = false; contents = v }