1:- module(arouter, [
    2    route/1,        % +Request
    3    route_get/2,    % +Route, :Goal
    4    route_post/2,   % +Route, :Goal
    5    route_put/2,    % +Route, :Goal
    6    route_del/2,    % +Route, :Goal
    7    route_get/3,    % +Route, :BeforeGoal, :Goal
    8    route_post/3,   % +Route, :BeforeGoal, :Goal
    9    route_put/3,    % +Route, :BeforeGoal, :Goal
   10    route_del/3,    % +Route, :BeforeGoal, :Goal
   11    new_route/3,    % +Method, +Route, :Goal
   12    new_route/4,    % +Method, +Route, :BeforeGoal, :Goal
   13    route_remove/2, % +Method, +Route
   14    route/4,        % ?Method, ?Route, ?Before, ?Goal
   15    path_to_route/2 % +Path, -Route
   16]).

   23:- use_module(library(debug)).   24:- use_module(library(error)).

 route(?Method, ?Route, ?Before, ?Goal) is nondet

Retrieves currently registered routes.

   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)).

 route_get(+Route, :Goal) is det

Registers a new GET route handler.

   47route_get(Route, Goal):-
   48    new_route(get, Route, Goal).

 route_put(+Route, :Goal) is det

Registers a new PUT route handler.

   54route_put(Route, Goal):-
   55    new_route(put, Route, Goal).

 route_del(+Route, :Goal) is det

Registers a new DELETE route handler.

   61route_del(Route, Goal):-
   62    new_route(delete, Route, Goal).

 route_post(+Route, :Goal) is det

Registers a new POST route handler.

   68route_post(Route, Goal):-
   69    new_route(post, Route, Goal).

 route_get(+Route, :Before, :Goal) is det

Registers a new GET route handler. Accepts Before goal.

   76route_get(Route, Before, Goal):-
   77    new_route(get, Route, Before, Goal).

 route_put(+Route, :Before, :Goal) is det

Registers a new PUT route handler. Accepts Before goal.

   84route_put(Route, Before, Goal):-
   85    new_route(put, Route, Before, Goal).

 route_del(+Route, :Before, :Goal) is det

Registers a new DELETE route handler. Accepts Before goal.

   92route_del(Route, Before, Goal):-
   93    new_route(delete, Route, Before, Goal).

 route_post(+Route, :Before, :Goal) is det

Registers a new POST route handler. Accepts Before goal.

  100route_post(Route, Before, Goal):-
  101    new_route(post, Route, Before, Goal).

 new_route(+Method, +Route, :Before, :Goal) is det

Registers a new method-specific route handler. Does nothing when the route already exists for the method.

  109new_route(Method, Route, Before, Goal):-
  110    must_be(atom, Method),
  111    check_route(Route),
  112    replace_add_route(Method, Route, goal(Before), Goal).

 new_route(+Method, +Route, :Goal) is det

Registers a new method-specific route handler. Does nothing when the route already exists for the method.

  120new_route(Method, Route, Goal):-
  121    must_be(atom, Method),
  122    check_route(Route),
  123    replace_add_route(Method, Route, none, Goal).
  124
  125% Replaces matching route in one step
  126% or adds a new route. Does not change
  127% the original order of routes.
  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
  137% Overwrites routes from the
  138% given array.
  139
  140overwrite_routes(Array):-
  141    Array =.. [_|List],
  142    retractall(route(_, _, _, _)),
  143    maplist(assertz, List).
  144
  145% Returns term with routes.
  146% Used as an array to simplify
  147% manipulation using indexes.
  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
  156% Checks whether the given array of
  157% routes has one with the matching
  158% method and route. Index is 1-based.
  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
  178% Matches route to path.
  179% This similar to route-route match
  180% but a route variable can match atomic
  181% value in the path.
  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
  197% Matches two routes to detect
  198% "same" routes. Does not bind
  199% variables between them
  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
  225% Finds clause references of all
  226% matching routes.
  227
  228existing_route(Method, Route, Ref):-
  229    clause(route(Method, RouteTest, _, _), _, Ref),
  230    route_route_match(Route, RouteTest).
  231
  232% Same as above but finds all matching routes.
  233
  234existing_routes(Method, Route, Refs):-
  235    findall(Ref, existing_route(Method, Route, Ref), Refs).

 route_remove(+Method, +Route) is det

Removes the given route. When either Method or Route or both are not set or are partially instantiated then all matching routes are removed. Method can be left unbound.

  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([]).

 route(+Request) is semidet

Routes the request into an handler. Fails when no handler is found. Request must contain method(Method) and path(Path). Throws handler_failed(Method, Path) when handler was found but it failed during execution.

  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
  273% Turns HEAD method into GET.
  274method_head_to_get(Method, ActualMethod):-
  275    (   Method = head
  276    ->  ActualMethod = get
  277    ;   ActualMethod = Method).

 dispatch(+Method, +Route) is semidet

Attempts to dispatch the request. Fails when no matching handler is found. Throws handler_failed(Method, Path) when handler was found but it failed during execution.

  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)))).

 path_route_matches(+Method, +Path, -Matches) is det

Finds list of matches as pairs of Before-Goal.

  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).

 path_to_route(+Path, -Route) is det

Turns path atom like '/path/to/something' into a Prolog term path/to/something.

  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'/ }