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