36
37:- module(http_help,
38 [ page_documentation_link//1 39 ]). 40:- use_module(http_tree). 41:- use_module(doc_components,
42 [ api_tester//2,
43 init_api_tester//0
44 ]). 45:- use_module(library(http/http_dispatch)). 46:- use_module(library(http/http_path)). 47:- use_module(library(http/http_json)). 48:- use_module(library(http/js_write)). 49:- use_module(library(http/html_write)). 50:- use_module(library(http/html_head)). 51:- use_module(library(http/http_host)). 52:- use_module(library(http/http_parameters)). 53:- use_module(library(option)). 54:- use_module(library(lists)). 55:- use_module(library(apply)). 56 57:- use_module(library(pldoc/doc_html)). 58:- use_module(library(pldoc/doc_process)). 59
72
73:- http_handler(root(help/http), http_help, []). 74:- http_handler(root(help/http_handler), help_on_handler, []). 75:- http_handler(root(help/http_ac_location), ac_location, []). 76
80
81page_documentation_link(Request) -->
82 { memberchk(path(Path), Request),
83 http_link_to_id(http_help, [location=Path], HREF),
84 http_absolute_location(icons('doc.png'), IMG, [])
85 },
86 html(a([id('dev-help'), href(HREF)],
87 img([ alt('Developer help'),
88 title('Page documentation'),
89 src(IMG)
90 ]))).
91
95
96http_help(Request) :-
97 http_parameters(Request,
98 [ location(Start,
99 [ optional(true),
100 description('Display help on location')
101 ])
102 ]),
103 http_current_host(Request, Host, Port, [global(true)]),
104 ( Port == 80
105 -> Authority = Host
106 ; format(atom(Authority), '~w:~w', [Host, Port])
107 ),
108 ( var(Start)
109 -> Options = []
110 ; Options = [ location(Start) ]
111 ),
112 reply_html_page(cliopatria(http_help),
113 title('Server help'),
114 [ body(class('yui-skin-sam'),
115 [ h1(class(title), 'Server at ~w'-[Authority]),
116 \help_page(Options)
117 ])
118 ]).
119
130
131help_page(Options) -->
132 { tree_view_options(TreeOptions) },
133 html([ \html_requires(css('httpdoc.css')),
134 \html_requires(pldoc),
135 \html_requires(js('api_test.js')),
136 div(id('http-tree'), \http_tree_view(TreeOptions)),
137 div(id('http-find'), \quick_find_div_content),
138 div(id('http-help'), \usage),
139 \script(Options),
140 \init_api_tester
141 ]).
142
143tree_view_options(
144[ labelClick('function(node) { helpNode(node) }')
145]).
146
147usage -->
148 html([ h4('Usage'),
149 p([ 'This page finds HTTP paths (locations) served by this ',
150 'server. You can find locations by browsing the hierarchy ',
151 'at the left or by entering a few characters from the ',
152 'path in the search box above. Autocompletion will show ',
153 'paths that contain the typed string.'
154 ])
155 ]).
156
157
163
164script(Options) -->
165 { http_link_to_id(help_on_handler, [], Handler)
166 },
167 html([ script(type('text/javascript'),
168 \[
169'function helpNode(node)\n',
170'{',
171' helpHTTP(node.data.path);\n',
172'}\n\n',
173'function helpHTTP(path)\n',
174'{',
175' var callback =\n',
176' { success: function(o)\n',
177' {\n',
178' var content = document.getElementById("http-help");\n',
179' content.innerHTML = o.responseText;\n',
180' }\n',
181' }\n',
182' var sUrl = "~w?location=" + encodeURIComponent(path);\n'-[Handler],
183' var transaction = YAHOO.util.Connect.asyncRequest("GET", sUrl, callback, null);\n',
184'}\n',
185 \start(Options)
186 ])
187 ]).
188
189start(Options) -->
190 { option(location(Start), Options)
191 }, !,
192 js_call(helpHTTP(Start)).
193start(_) --> [].
194
195
202
203help_on_handler(Request) :-
204 http_parameters(Request,
205 [ location(Path,
206 [ description('Location on this server to describe')
207 ])
208 ]),
209 ( http_current_handler(Path, M:H, Options)
210 -> reply_html_page([],
211 [ h1(['HTTP location ', Path]),
212 \handler(Request, Path, M:H, Options)
213 ])
214 ; reply_html_page([],
215 [ h4(['No handler for ', Path])
216 ])
217 ).
218
219handler(_Request, Path, _:http_redirect(How, Where), _Options) --> !,
220 { Where = location_by_id(Id)
221 -> http_location_by_id(Id, URL)
222 ; http_absolute_location(Where, URL, [relative_to(Path)])
223 },
224 html(p([ 'Location redirects (using "', i(\status(How)), '") to ',
225 a([href('javascript:helpHTTP("'+URL+'")')], URL),
226 '.'
227 ])).
228handler(_Request, Path, _:http_reply_file(File, Options), _Options) --> !,
229 file_handler(File, Path, Options).
230handler(Request, Path, Closure, Options) -->
231 { extend_closure(Closure, [_], Closure1),
232 extracted_parameters(Closure1, Params)
233 },
234 html(h4('Implementation')),
235 predicate_help(Request, Closure1),
236 html(h4('Test this API')),
237 api_tester(Path, Params),
238 html(h4('Parameters for this API')),
239 parameter_table(Params),
240 dispatch_options(Options, Path).
241
242file_handler(Spec, Location, Options) -->
243 { ( absolute_file_name(Spec, Path,
244 [ access(read),
245 file_errors(fail)
246 ])
247 -> true
248 ; Path = '<not found>'
249 ),
250 term_to_atom(Spec, SpecAtom),
251 default_options([cache(true)], Options, Options1)
252 },
253 html([ p([ 'Location serves a plain file' ]),
254 table(class(file_handler),
255 [ tr([th('File:'), td(a(href(Location), Path))]),
256 tr([th('Symbolic:'), td(SpecAtom)])
257 | \file_options(Options1)
258 ])
259 ]).
260
261default_options([], Options, Options).
262default_options([H|T], Options0, Options) :-
263 functor(H, Name, 1),
264 functor(Gen, Name, 1),
265 ( option(Gen, Options0)
266 -> default_options(T, Options0, Options)
267 ; default_options(T, [H|Options0], Options)
268 ).
269
270file_options([]) --> [].
271file_options([H|T]) -->
272 file_option(H),
273 file_options(T).
274
275file_option(Name=Value) --> !,
276 { Term =.. [Name, Value] },
277 file_option(Term).
278file_option(cache(true)) --> !,
279 html(tr([ th('Cache:'),
280 td(['Supports ', code('If-modified-since')])
281 ])).
282file_option(mime_type(Type)) --> !,
283 html(tr([ th('Mime-type'), td(Type) ])).
284file_option(_) -->
285 [].
286
292
293status(How) -->
294 { http_header:status_number(How, Code),
295 phrase(http_header:status_comment(How), CommentCodes),
296 atom_codes(Comment, CommentCodes)
297 },
298 html([Code, Comment]).
299
300
304
305predicate_help(Request, Closure) -->
306 { resolve_location(Closure, Closure1),
307 closure_pi(Closure1, PI),
308 edit_options(Request, Options)
309 },
310 object_page(PI,
311 [ header(false)
312 | Options
313 ]), !.
314predicate_help(_Request, Closure) -->
315 { closure_pi(Closure, PI) },
316 html(p('The implementing predicate ~q is not documented'-[PI])).
317
318resolve_location(Closure, M:G) :-
319 predicate_property(Closure, imported_from(M)), !,
320 strip_module(Closure, _, G).
321resolve_location(Closure, Closure).
322
323
328
329edit_options(Request, [edit(true)]) :-
330 catch(http:authenticate(pldoc(edit), Request, _), _, fail), !.
331edit_options(_, []).
332
333
337
338dispatch_options([], _) -->
339 [].
340dispatch_options(List, Path) -->
341 html([ h4('Notes'),
342 ul(class(http_options),
343 \dispatch_items(List, Path))
344 ]).
345
346dispatch_items([], _) --> [].
347dispatch_items([H|T], Path) -->
348 dispatch_item(H, Path),
349 dispatch_items(T, Path).
350
351
352dispatch_item(prefix(true), Path) --> !,
353 html(li(['Handler processes all paths that start with ', code(Path)])).
354dispatch_item(Option, _) -->
355 dispatch_item(Option), !.
356
357dispatch_item(authentication(_)) --> !,
358 html(li('Request requires authentication')).
359dispatch_item(time_limit(Limit)) --> !,
360 ( { number(Limit) }
361 -> html(li('Server limits processing time to ~w seconds'-[Limit]))
362 ; []
363 ).
364dispatch_item(chunked) --> !,
365 html(li('Reply uses HTTP chunked encoding if possible')).
366dispatch_item(spawn(On)) --> !,
367 ( {atom(On)}
368 -> html(li(['Requests are spawned on pool "', i(On), '"']))
369 ; html(li('Requests are spawned on a new thread'))
370 ).
371dispatch_item(_) -->
372 [].
373
374
378
379parameter_table([]) --> !,
380 html(p(class(http_parameters),
381 'Request does not handle parameters')).
382parameter_table(Params) -->
383 html([ table(class(http_parameters),
384 [ tr([th('Name'), th('Type'), th('Default'), th('Description')])
385 | \parameters(Params, 1)
386 ])
387 ]).
388
389parameters([], _) --> [].
390parameters([group(Members, Options)|T], _N) --> !,
391 html(tr(class(group),
392 [ th(colspan(4), \group_title(Options))
393 ])),
394 parameters(Members, 0),
395 396 397 parameters(T, 0).
398parameters([H|T], N) -->
399 { N1 is N + 1,
400 ( N mod 2 =:= 0
401 -> Class = even
402 ; Class = odd
403 )
404 },
405 parameter(H, Class),
406 parameters(T, N1).
407
408parameter(param(Name, Options), Class) -->
409 html(tr(class(Class),
410 [ td(class(name), Name),
411 td(\param_type(Options)),
412 td(\param_default(Options)),
413 td(\param_description(Options))
414 ])).
415
416group_title(Options) -->
417 { option(description(Title), Options)
418 }, !,
419 html(Title).
420group_title(Options) -->
421 { option(generated(Pred), Options), !,
422 ( doc_comment(Pred, _Pos, Summary0, _Comment)
423 -> ( atom_concat(Summary, '.', Summary0)
424 -> true
425 ; Summary = Summary0
426 )
427 ; format(string(Summary), 'Parameter group generated by ~q', [Pred])
428 )
429 },
430 html(Summary).
431group_title(_) -->
432 html('Parameter group').
433
437
438param_type(Options) -->
439 { select(list(Type), Options, Rest) }, !,
440 param_type([Type|Rest]).
441param_type(Options) -->
442 { type_term(Type),
443 memberchk(Type, Options), !
444 },
445 type(Type).
446param_type(_) -->
447 html(string).
448
449type((T1;T2)) --> !,
450 type(T1),
451 breaking_bar,
452 type(T2).
453type(between(L,H)) --> !,
454 html('number in [~w..~w]'-[L,H]).
455type(oneof(Set)) --> !,
456 html(code(\set(Set))).
457type(length > N) --> !,
458 html('string(>~w chars)'-[N]).
459type(length >= N) --> !,
460 html('string(>=~w chars)'-[N]).
461type(length > N) --> !,
462 html('string(<~w chars)'-[N]).
463type(length =< N) --> !,
464 html('string(=<~w chars)'-[N]).
465type(nonneg) --> !,
466 html('integer in [0..)').
467type(uri) --> !,
468 html(['URI', \breaking_bar, 'NS:Local']).
469type(X) -->
470 { term_to_atom(X, A) },
471 html(A).
472
473set([]) --> [].
474set([H|T]) -->
475 html(H),
476 ( { T == [] }
477 -> []
478 ; breaking_bar,
479 set(T)
480 ).
481
486
487breaking_bar -->
488 html(['|', &('#8203')]).
489
495
496type_term(Term) :-
497 clause(http_parameters:check_type3(Term, _, _), _),
498 nonvar(Term).
499type_term(Term) :-
500 clause(http:convert_parameter(Term, _, _), _).
501type_term(Term) :-
502 clause(http_parameters:check_type2(Term, _), _),
503 nonvar(Term).
504
505param_default(Options) -->
506 { memberchk(default(Value), Options), !
507 },
508 html(code('~w'-[Value])).
509param_default(Options) -->
510 { option(optional(true), Options) }, !,
511 html(i(optional)).
512param_default(Options) -->
513 { memberchk(zero_or_more, Options)
514 ; memberchk(list(_Type), Options)
515 }, !,
516 html(i(multiple)).
517param_default(_Options) -->
518 html(i(required)).
519
520param_description(Options) -->
521 { option(description(Text), Options) }, !,
522 html(Text).
523param_description(_) --> [].
524
525
530
(Closure, Declarations) :-
532 calls(Closure, 5, Goals),
533 closure_last_arg(Closure, Request),
534 phrase(param_decls(Goals, Request), Declarations0),
535 list_to_set(Declarations0, Declarations).
536
537param_decls([], _) -->
538 [].
539param_decls([H|T], Request) -->
540 param_decl(H, Request),
541 param_decls(T, Request).
542
543param_decl(Var, _) -->
544 { var(Var) }, !.
545param_decl(M:http_parameters(Rq, Decls), Request) --> !,
546 param_decl(M:http_parameters(Rq, Decls, []), Request).
547param_decl(M:http_parameters(Rq, Decls, Options), Request) -->
548 { ignore(Rq == Request), !,
549 decl_goal(Options, M, Decl)
550 },
551 params(Decls, Decl).
552param_decl(_, _) -->
553 [].
554
555decl_goal(Options, M, Module:Goal) :-
556 option(attribute_declarations(G), Options), !,
557 strip_module(M:G, Module, Goal).
558decl_goal(_, _, -).
559
560:- meta_predicate
561 params(+, 2, ?, ?),
562 param(+, 2, ?, ?). 563
564params(V, _) -->
565 { var(V) }, !.
566params([], _) -->
567 [].
568params([H|T], Decl) -->
569 param(H, Decl),
570 params(T, Decl).
571
572param(Term, _) -->
573 { \+ compound(Term) }, !.
574param(group(Params0, Options), Decl) --> !,
575 { phrase(params(Params0, Decl), GroupedParams) },
576 [ group(GroupedParams, Options) ].
577param(Term, _) -->
578 { Term =.. [Name, _Value, Options] }, !,
579 [ param(Name, Options) ].
580param(Term, Decl) -->
581 { Term =.. [Name, _Value],
582 catch(call(Decl, Name, Options), _, fail), !
583 },
584 [ param(Name, Options) ].
585param(_, _) -->
586 [].
587
588 591
595
596extend_closure(Var, _, _) :-
597 var(Var), !, fail.
598extend_closure(M:C0, Extra, M:C) :- !,
599 extend_closure(C0, Extra, C).
600extend_closure(C0, Extra, C) :-
601 C0 =.. L0,
602 append(L0, Extra, L),
603 C =.. L.
604
605closure_pi(M:C, M:Name/Arity) :- !,
606 functor(C, Name, Arity).
607closure_pi(C, Name/Arity) :-
608 functor(C, Name, Arity).
609
610closure_last_arg(C, _) :-
611 var(C), !,
612 instantiation_error(C).
613closure_last_arg(_:C, Last) :- !,
614 closure_last_arg(C, Last).
615closure_last_arg(C, Last) :-
616 functor(C, _, Arity),
617 arg(Arity, C, Last).
618
619
620 623
630
631:- meta_predicate
632 calls(:, +, -). 633
634calls(M:Goal, Depth, SubGoals) :-
635 phrase(calls(Goal, M, Depth, SubGoals0), SubGoals0), !,
636 maplist(unqualify, SubGoals0, SubGoals).
637
638unqualify(Var, Var) :-
639 var(Var), !.
640unqualify(S:G, G) :-
641 S == system, !.
642unqualify(S:G, G) :-
643 predicate_property(S:G, imported_from(system)), !.
644unqualify(G, G).
645
646calls(_, _, 0, _) --> !.
647calls(Var, _, _, _) -->
648 { var(Var), ! },
649 [ Var ].
650calls(Goal, M, _, Done) -->
651 { seen_goal(M:Goal, Done) }, !.
652calls(M:G, _, D, Done) --> !,
653 calls(G, M, D, Done).
654calls(Control, M, Depth, Done) -->
655 { control(Control, Members)
656 }, !,
657 bodies(Members, M, Depth, Done).
658calls(Goal, M, _, _) -->
659 { evaluate_now(M:Goal), !,
660 ignore(catch(M:Goal, _, fail))
661 },
662 [].
663calls(Goal, M, _, _) -->
664 { primitive(M:Goal) }, !,
665 [ M:Goal ].
666calls(Goal, M, Depth, Done) -->
667 { term_variables(Goal, Vars),
668 Key =.. [v|Vars],
669 '$define_predicate'(M:Goal), 670 def_module(M:Goal, DefM),
671 qualify_goal(DefM:Goal, M, QGoal),
672 catch(findall(Key-Body, clause(QGoal, Body), Pairs), _, fail),
673 SubDepth is Depth - 1
674 },
675 [ M:Goal ],
676 vars_bodies(Pairs, DefM, SubDepth, Done),
677 { bind_vars(Key, Pairs) }.
678
679def_module(Callable, M) :-
680 predicate_property(Callable, imported_from(M)), !.
681def_module(Callable, M) :-
682 strip_module(Callable, M, _).
683
684qualify_goal(M:G, Ctx, M:QG) :-
685 predicate_property(G, meta_predicate(Meta)), !,
686 functor(Meta, Name, Arity),
687 functor(G, Name, Arity),
688 functor(QG, Name, Arity),
689 qualify_args(1, Arity, Ctx, Meta, G, QG).
690qualify_goal(G, _, G).
691
692qualify_args(I, Arity, Ctx, Meta, G, QG) :-
693 I =< Arity, !,
694 arg(I, Meta, MA),
695 arg(I, G, GA),
696 ( ismeta(MA),
697 \+ isqual(GA)
698 -> arg(I, QG, Ctx:GA)
699 ; arg(I, QG, GA)
700 ),
701 I2 is I+1,
702 qualify_args(I2, Arity, Ctx, Meta, G, QG).
703qualify_args(_, _, _, _, _, _).
704
705ismeta(:).
706ismeta(I) :- integer(I).
707
708isqual(M:_) :-
709 atom(M).
710
711vars_bodies([], _, _, _) --> [].
712vars_bodies([_-Body|T], M, Depth, Done) -->
713 calls(Body, M, Depth, Done),
714 vars_bodies(T, M, Depth, Done).
715
716bodies([], _, _, _) --> [].
717bodies([H|T], M, Depth, Done) -->
718 calls(H, M, Depth, Done),
719 bodies(T, M, Depth, Done).
720
733
734bind_vars(Key, Pairs) :-
735 functor(Key, _, Arity),
736 bind_vars(1, Arity, Key, Pairs).
737
738bind_vars(I, Arity, Key, Pairs) :-
739 I =< Arity, !,
740 arg(I, Key, V),
741 maplist(pair_arg(I), Pairs, Vars),
742 ignore(maplist(=(V), Vars)).
743bind_vars(_, _, _, _).
744
745pair_arg(I, Key-_, V) :-
746 arg(I, Key, V).
747
748control((A,B), [A,B]).
749control((A;B), [A,B]).
750control((A->B), [A,B]).
751control((A*->B), [A,B]).
752control(call(G, A1), [Goal]) :-
753 extend_closure(G, [A1], Goal).
754control(call(G, A1, A2), [Goal]) :-
755 extend_closure(G, [A1, A2], Goal).
756control(call(G, A1, A2, A3), [Goal]) :-
757 extend_closure(G, [A1, A2, A3], Goal).
758control(call(G, A1, A2, A3, A4), [Goal]) :-
759 extend_closure(G, [A1, A2, A3, A4], Goal).
760
761primitive(_:Goal) :-
762 functor(Goal, Name, Arity),
763 current_predicate(system:Name/Arity), !.
764primitive(Goal) :-
765 \+ predicate_property(Goal, interpreted).
766
767seen_goal(Goal, Done) :-
768 member_open_list(X, Done),
769 variant(X, Goal), !.
770
771member_open_list(_, List) :-
772 var(List), !, fail.
773member_open_list(X, [X|_]).
774member_open_list(X, [_|T]) :-
775 member_open_list(X, T).
776
785
790
791:- multifile
792 evaluate/1. 793
794evaluate_now(Var) :-
795 var(Var), !, fail.
796evaluate_now(Goal) :-
797 evaluate(Goal), !.
798evaluate_now(_:Goal) :-
799 evaluate_now(Goal).
800evaluate_now(_ = _).
801evaluate_now(_ is _).
802evaluate_now(append(L1,L2,_)) :-
803 is_list(L1),
804 is_list(L2).
805evaluate_now(append(L1,_)) :-
806 is_list(L1),
807 maplist(is_list, L1).
808
809
810 813
814max_results_displayed(50).
815
816quick_find_div_content -->
817 html([ span(id(qf_label), 'Quick find:'),
818 \autocomplete_finder,
819 input([ value('Show'), type(submit),
820 onClick('showLocation();')
821 ]),
822 script(type('text/javascript'),
823 [ 'function showLocation()\n',
824 '{ helpHTTP(document.getElementById("ac_location_input").value);\n',
825 '}'
826 ])
827 ]).
828
829autocomplete_finder -->
830 { max_results_displayed(Max)
831 },
832 autocomplete(ac_location,
833 [ query_delay(0.2),
834 auto_highlight(false),
835 max_results_displayed(Max),
836 width('40ex')
837 ]).
838
851
852autocomplete(Handler, Options) -->
853 { http_location_by_id(Handler, Path),
854 atom_concat(Handler, '_complete', CompleteID),
855 atom_concat(Handler, '_input', InputID),
856 atom_concat(Handler, '_container', ContainerID),
857 select_option(width(Width), Options, Options1, '25em'),
858 select_option(name(Name), Options1, Options2, predicate),
859 select_option(value(Value), Options2, Options3, '')
860 },
861 html([ \html_requires(yui('autocomplete/autocomplete.js')),
862 \html_requires(yui('autocomplete/assets/skins/sam/autocomplete.css')),
863 div(id(CompleteID),
864 [ input([ id(InputID),
865 name(Name),
866 value(Value),
867 type(text)
868 ]),
869 div(id(ContainerID), [])
870 ]),
871 style(type('text/css'),
872 [ '#', CompleteID, '\n',
873 '{ width:~w; padding-bottom:0em; display:inline-block; vertical-align:top}'-[Width]
874 ]),
875 \autocomplete_script(Path, InputID, ContainerID, Options3)
876 ]).
877
878autocomplete_script(HandlerID, Input, Container, Options) -->
879 { http_absolute_location(HandlerID, Path, [])
880 },
881 html(script(type('text/javascript'), \[
882'{ \n',
883' var oDS = new YAHOO.util.XHRDataSource("~w");\n'-[Path],
884' oDS.responseType = YAHOO.util.XHRDataSource.TYPE_JSON;\n',
885' oDS.responseSchema = { resultsList:"results",
886 fields:["label","location"]
887 };\n',
888' oDS.maxCacheEntries = 5;\n',
889' var oAC = new YAHOO.widget.AutoComplete("~w", "~w", oDS);\n'-[Input, Container],
890' oAC.resultTypeList = false;\n',
891' oAC.formatResult = function(oResultData, sQuery, sResultMatch) {
892 var into = "<span class=\\"acmatch\\">"+sQuery+"</span>";
893 var sLabel = oResultData.label.replace(sQuery, into);
894 return sLabel;
895 };\n',
896' oAC.itemSelectEvent.subscribe(function(sType, aArgs) {
897 var oData = aArgs[2];
898 helpHTTP(oData.location);
899 });\n',
900\ac_options(Options),
901'}\n'
902 ])).
903ac_options([]) -->
904 [].
905ac_options([H|T]) -->
906 ac_option(H),
907 ac_options(T).
908
909ac_option(query_delay(Time)) --> !,
910 html([ ' oAC.queryDelay = ~w;\n'-[Time] ]).
911ac_option(auto_highlight(Bool)) --> !,
912 html([ ' oAC.autoHighlight = ~w;\n'-[Bool] ]).
913ac_option(max_results_displayed(Max)) -->
914 html([ ' oAC.maxResultsDisplayed = ~w;\n'-[Max] ]).
915ac_option(O) -->
916 { domain_error(yui_autocomplete_option, O) }.
917
921
922ac_location(Request) :-
923 max_results_displayed(DefMax),
924 http_parameters(Request,
925 [ query(Query, [ description('String to find in HTTP path') ]),
926 maxResultsDisplayed(Max,
927 [ integer, default(DefMax),
928 description('Max number of results returned')
929 ])
930 ]),
931 autocompletions(Query, Max, Count, Completions),
932 reply_json(json([ query = json([ count=Count
933 ]),
934 results = Completions
935 ])).
936
937autocompletions(Query, Max, Count, Completions) :-
938 findall(C, ac_object(Query, C), Completions0),
939 sort(Completions0, Completions1),
940 length(Completions1, Count),
941 first_n(Max, Completions1, Completions2),
942 maplist(obj_result, Completions2, Completions).
943
944obj_result(Location, json([ label=Location,
945 location=Location
946 ])).
947
948first_n(0, _, []) :- !.
949first_n(_, [], []) :- !.
950first_n(N, [H|T0], [H|T]) :-
951 N2 is N - 1,
952 first_n(N2, T0, T).
953
954ac_object(Query, Location) :-
955 http_current_handler(Location, _:_Handler, _Options),
956 sub_atom(Location, _, _, _, Query)