1:- module(arouter, [
2 route/1, 3 route_get/2, 4 route_post/2, 5 route_put/2, 6 route_del/2, 7 route_get/3, 8 route_post/3, 9 route_put/3, 10 route_del/3, 11 new_route/3, 12 new_route/4, 13 route_remove/2, 14 route/4, 15 path_to_route/2 16]).
23:- use_module(library(debug)). 24:- use_module(library(error)).
30:- dynamic(route/4). 31
32:- meta_predicate(route_get(+, 0)). 33:- meta_predicate(route_post(+, 0)). 34:- meta_predicate(route_put(+, 0)). 35:- meta_predicate(route_del(+, 0)). 36:- meta_predicate(route_get(+, 1, 0)). 37:- meta_predicate(route_post(+, 1, 0)). 38:- meta_predicate(route_put(+, 1, 0)). 39:- meta_predicate(route_del(+, 1, 0)). 40:- meta_predicate(new_route(+, +, 0)). 41:- meta_predicate(new_route(+, +, 1, 0)).
47route_get(Route, Goal):-
48 new_route(get, Route, Goal).
54route_put(Route, Goal):-
55 new_route(put, Route, Goal).
61route_del(Route, Goal):-
62 new_route(delete, Route, Goal).
68route_post(Route, Goal):-
69 new_route(post, Route, Goal).
76route_get(Route, Before, Goal):-
77 new_route(get, Route, Before, Goal).
84route_put(Route, Before, Goal):-
85 new_route(put, Route, Before, Goal).
92route_del(Route, Before, Goal):-
93 new_route(delete, Route, Before, Goal).
100route_post(Route, Before, Goal):-
101 new_route(post, Route, Before, Goal).
109new_route(Method, Route, Before, Goal):-
110 must_be(atom, Method),
111 check_route(Route),
112 replace_add_route(Method, Route, goal(Before), Goal).
120new_route(Method, Route, Goal):-
121 must_be(atom, Method),
122 check_route(Route),
123 replace_add_route(Method, Route, none, Goal).
124
128
129replace_add_route(Method, Route, Before, Goal):-
130 routes_array(Array),
131 ( array_route(Array, Method, Route, Index)
132 -> setarg(Index, Array, route(Method, Route, Before, Goal)),
133 copy_term(Array, Copy),
134 overwrite_routes(Copy)
135 ; asserta(route(Method, Route, Before, Goal))).
136
139
140overwrite_routes(Array):-
141 Array =.. [_|List],
142 retractall(route(_, _, _, _)),
143 maplist(assertz, List).
144
148
149routes_array(Routes):-
150 findall(
151 route(Method, Route, Before, Goal),
152 route(Method, Route, Before, Goal),
153 List),
154 Routes =.. [array|List].
155
159
160array_route(Array, Method, Route, Index):-
161 \+ atom(Array),
162 arg(Index, Array, route(Method, ERoute, _, _)),
163 route_route_match(Route, ERoute).
164
165check_route(Atom):-
166 atomic(Atom), !.
167
168check_route(Var):-
169 var(Var), !.
170
171check_route(/(Left, Right)):-
172 check_route(Left),
173 check_route(Right), !.
174
175check_route(Route):-
176 throw(error(invalid_route(Route))).
177
182
183route_path_match(Route, /):- !,
184 nonvar(Route),
185 Route = '/'.
186
187route_path_match(Route, Atomic):-
188 atomic(Atomic), !,
189 Route = Atomic.
190
191route_path_match(Route, /(LeftPath, RightPath)):-
192 nonvar(Route), !,
193 Route = /(LeftRoute, RightRoute),
194 route_path_match(LeftRoute, LeftPath),
195 route_path_match(RightRoute, RightPath).
196
200
201route_route_match(Root1, Root2):-
202 nonvar(Root1),
203 nonvar(Root2),
204 Root1 = '/',
205 Root2 = '/', !.
206
207route_route_match(Atomic1, Atomic2):-
208 atomic(Atomic1),
209 atomic(Atomic2),
210 Atomic1 \= '/',
211 Atomic1 = Atomic2, !.
212
213route_route_match(Var1, Var2):-
214 var(Var1),
215 var(Var2), !.
216
217route_route_match(Route1, Route2):-
218 nonvar(Route1),
219 nonvar(Route2),
220 Route1 = /(Left1, Right1),
221 Route2 = /(Left2, Right2),
222 route_route_match(Left1, Left2),
223 route_route_match(Right1, Right2).
224
227
228existing_route(Method, Route, Ref):-
229 clause(route(Method, RouteTest, _, _), _, Ref),
230 route_route_match(Route, RouteTest).
231
233
234existing_routes(Method, Route, Refs):-
235 findall(Ref, existing_route(Method, Route, Ref), Refs).
244route_remove(Method, Route):-
245 check_route(Route),
246 existing_routes(Method, Route, Refs),
247 remove_refs(Refs).
248
249remove_refs([Ref|Refs]):-
250 erase(Ref),
251 remove_refs(Refs).
252
253remove_refs([]).
265route(Request):-
266 memberchk(method(Method), Request),
267 memberchk(path(Path), Request),
268 path_to_route(Path, Route),
269 debug(arouter, 'dispatch: ~p ~p', [Method, Route]),
270 method_head_to_get(Method, ActualMethod),
271 dispatch(ActualMethod, Route).
272
274method_head_to_get(Method, ActualMethod):-
275 ( Method = head
276 -> ActualMethod = get
277 ; ActualMethod = Method).
287dispatch(Method, Path):-
288 path_route_matches(Method, Path, Matches),
289 try_next_match(Matches, Method, Path).
290
291try_next_match([Before-Goal|Matches], Method, Path):-
292 catch(try_run_handler(Before, Goal, Method, Path), Error, true),
293 ( nonvar(Error), Error = arouter_next
294 -> try_next_match(Matches, Method, Path)
295 ; ( nonvar(Error)
296 -> throw(Error)
297 ; true)).
298
299:- meta_predicate(try_run_handler(+, 0, +, +)). 300
301try_run_handler(Before, Goal, Method, Path):-
302 ( run_handler(Before, Goal)
303 -> true
304 ; throw(error(handler_failed(Method, Path)))).
310path_route_matches(Method, Path, Matches):-
311 findall(Before-Goal,
312 (
313 route(Method, Route, Before, Goal),
314 route_path_match(Route, Path)),
315 Matches).
316
317:- meta_predicate(run_handler(+, 0)). 318
319run_handler(Before, Goal):- !,
320 ( Before = goal(BeforeGoal)
321 -> call(BeforeGoal, arouter:run_handler(Goal))
322 ; run_handler(Goal)).
323
324:- meta_predicate(run_handler(0)). 325
326run_handler(Handler):-
327 call(Handler).
334path_to_route(Path, Route):-
335 atom_codes(Path, Codes),
336 phrase(path_tokens([/|Tokens]), Codes),
337 path_to_route_term(Tokens, Route), !.
338
339path_to_route_term([], /).
340
341path_to_route_term([First|Rest], Term):-
342 path_to_route_term(Rest, First, Term).
343
344path_to_route_term([/,A|Rest], Acc, Term):-
345 path_to_route_term(Rest, /(Acc, A), Term).
346
347path_to_route_term([A], Acc, Route):-
348 ( A = (/)
349 -> Route = /(Acc, '')
350 ; Route = /(Acc, A)).
351
352path_to_route_term([], Acc, Acc).
353
354path_tokens([Token|Tokens]) -->
355 path_token(Token),
356 path_tokens(Tokens).
357
358path_tokens([]) --> [].
359
360path_token(/) --> "/", !.
361
362path_token(Atom) -->
363 path_char(Char), !,
364 path_char_token(Chars),
365 { atom_chars(Atom, [Char|Chars]) }.
366
367path_char_token([Char|Chars]) -->
368 path_char(Char), !,
369 path_char_token(Chars).
370
371path_char_token([]) --> [].
372
373path_char(Char) --> [Char], { Char \= 0'/ }
Alternative HTTP routing
HTTP routing with path expressions. */