34
35:- module(broker,
36 [ add_server/2,
37 del_server/1,
38 module_server/2
39 ]). 40
41:- use_module(library(lists)). 42:- use_module(library(neck)). 43:- use_module(library(codegen)). 44:- reexport(library(compound_expand)). 45:- use_module(library(change_alias)). 46:- reexport(library(interface)). 47:- init_expansors.
63:- dynamic
64 module_server/2. 65
66:- multifile
67 '$broker'/1. 68
69alias_file(RelTo, Alias, File) :-
70 absolute_file_name(Alias, File, [file_type(prolog), relative_to(RelTo)]).
71
72add_server(Module, URL) :-
73 '$broker'(Module),
74 assertz(module_server(Module, URL)).
75
76del_server(Module) :-
77 '$broker'(Module),
78 retractall(module_server(Module, _)).
79
80generate_broker(Target, File, Module, AliasTo) -->
81 { prolog_load_context(source, RelTo),
82 atom_concat(Module, '_intf', Interface),
83 atom_concat(Module, '_remt', ImplRemote),
84 atom_concat(Module, '_locl', ImplLocal)
85 },
86 [broker:'$broker'(Module)],
87 generate_interface( File, RelTo, Module, Interface, AliasTo, AliasIntf),
88 generate_local( Target, File, RelTo, Module, ImplLocal, AliasTo, AliasIntf),
89 generate_remote(Target, File, RelTo, Module, ImplRemote, AliasTo, AliasIntf),
90 generate_server(Target, File, RelTo, Module, Interface, AliasTo),
91 {bind_implementation(Target, ImplLocal, ImplRemote, BindModule)},
92 [(:- initialization(bind_interface(Interface, BindModule)))].
93
94bind_implementation(client, _, M, M).
95bind_implementation(server, M, _, M).
96bind_implementation(proxy, _, M, M).
97bind_implementation(A,B,C,D) :- writeln(user_error, bind_implementation(A,B,C,D)),fail.
98
99generate_interface(File, RelTo, Module, Interface, AliasTo, AliasIntf) -->
100 {generate_file('_intf', File, RelTo, AliasTo, AliasIntf, dump_interface(Module, Interface))},
101 [(:- use_module(AliasIntf))].
102
103generate_local(Target, _, _, _, _, _, _) -->
104 {member(Target, [client, proxy])},
105 neck.
106generate_local(server, File, RelTo, Module, ImplLocal, AliasTo, AliasIntf) -->
107 generate_file('_locl', File, RelTo, AliasTo, _, dump_local(Module, ImplLocal, AliasIntf)).
108
109generate_remote(server, _, _, _, _, _, _) --> [].
110generate_remote(Target, File, RelTo, Module, ImplRemote, AliasTo, AliasIntf) -->
111 {member(Target, [client, proxy])},
112 neck,
113 generate_file('_remt', File, RelTo, AliasTo, _, dump_remote(Module, ImplRemote, AliasIntf)).
114
115generate_server(client, _, _, _, _, _) --> [].
116generate_server(Target, File, RelTo, Module, Interface, AliasTo) -->
117 {member(Target, [server, proxy])},
118 neck,
119 generate_file('_serv', File, RelTo, AliasTo, _, dump_server(Module, Interface)).
120
121:- meta_predicate
122 generate_file(+,+,+,+,+,2),
123 generate_file(+,+,+,+,+,2,?,?). 124
125generate_file(Suffix, File, RelTo, AliasIntf, AliasSuff, Dump) :-
126 change_alias(add_suffix(Suffix), AliasIntf, AliasSuff),
127 alias_file(RelTo, AliasSuff, FileSuff),
128 ( is_newer(FileSuff, File)
129 ->true
130 ; save_to_file(FileSuff, Dump)
131 ).
132
133generate_file(Suffix, File, RelTo, AliasIntf, AliasSuff, Dump) -->
134 {generate_file(Suffix, File, RelTo, AliasIntf, AliasSuff, Dump)},
135 [(:- use_module(AliasSuff, []))].
136
137dump_interface(Module, Interface) -->
138 [(:- module(Interface, [])),
139 (:- use_module(library(interface))),
140 (:- interfaces_mod(Module))].
141
142dump_local(Module, ImplLocal, AliasIntf) -->
143 [(:- module(ImplLocal, [])),
144 (:- use_module(library(interface))),
145 (:- implements(AliasIntf)),
146 (:- module_property(Module, file(File)),
147 reexport(File))].
148
149dump_remote(Module, ImplRemote, AliasIntf) -->
150 [(:- module(ImplRemote, [])),
151 (:- use_module(library(interface))),
152 (:- use_module(library(broker_rt))),
153 (:- implements(AliasIntf))
154 ],
155 findall((H :- remote_call(H, Module)),
156 ( module_property(Module, exports(PIL)),
157 member(F/A, PIL),
158 functor(H, F, A)
159 )).
160
161dump_server(Module, Interface) -->
162 {atom_concat(Module, '_serv', ImplService)},
163 [(:- module(ImplService, [])),
164 (:- use_module(library(http/http_dispatch))),
165 (:- use_module(library(http/websocket))),
166 (:- use_module(library(interface))),
167 (:- use_module(library(broker_ws))),
168 (:- http_handler(root(broker/Module),
169 http_upgrade_to_websocket(broker_ws(Interface), []),
170 [spawn([])]))].
171
172term_expansion_broker(Target, Alias, AliasIntf) -->
173 { use_module(Alias, []), 174 absolute_file_name(Alias, File, [file_type(prolog), access(read)]),
175 module_property(Module, file(File))
176 },
177 generate_broker(Target, File, Module, AliasIntf).
178
179term_expansion((:- broker_client(Alias, AliasIntf)), Clauses) :-
180 phrase(term_expansion_broker(client, Alias, AliasIntf), Clauses).
181term_expansion((:- broker_server(Alias, AliasIntf)), Clauses) :-
182 phrase(term_expansion_broker(server, Alias, AliasIntf), Clauses).
183term_expansion((:- broker_proxy( Alias, AliasIntf)), Clauses) :-
184 phrase(term_expansion_broker(proxy, Alias, AliasIntf), Clauses)
WebSocket broker
WebSocket broker that allows to execute predicates remotely.
balancing roundrobin leastconec
*/