View source with raw comments or as raw
    1:- module(
    2  generics,
    3  [
    4    clean_dom/2, % +DOM:list
    5                 % -CleanedDOM:list
    6    ensure_number/2, % +Something:term
    7                     % -Number:number
    8    is_empty/1, % +Content:atom
    9    login_link//0,
   10    request_to_id/3, % +Request:list
   11                     % +Kind:oneof([annotation,news,post])
   12                     % -Id:atom
   13    true/1, % +Term
   14    uri_query_add/4, % +FromURI:uri
   15                     % +Name:atom
   16                     % +Value:atom
   17                     % -ToURI:atom
   18    wiki_file_codes_to_dom/3 % +Codes:list(code)
   19                             % +File:atom
   20                             % -DOM:list
   21  ]
   22).

Generics

Generic predicates in plweb. Candidates for placement in some library.

author
- Wouter Beek
version
- 2013/12-2014/01 */
   33:- use_module(library(apply)).   34:- use_module(library(http/http_dispatch)).   35:- use_module(library(http/http_path)).   36:- use_module(library(http/http_wrapper)).   37:- use_module(library(option)).   38:- use_module(library(pldoc/doc_wiki)).   39:- use_module(library(semweb/rdf_db)).   40:- use_module(library(uri)).   41:- use_module(openid).
 add_option(+FromOptions:list(nvpair), +Name:atom, +Value:atom, +ToOptions:list(nvpair)) is det
Adds an option with the given name and value (i.e. `Name(Value)`), and ensures that old options are overwritten and that the resultant options list is sorted.
   53add_option(Os1, N, V, Os2):-
   54  O =.. [N,V],
   55  merge_options([O], Os1, Os2).
   56
   57clean_dom([p(X)], X) :- !.
   58clean_dom(X, X).
   59
   60ensure_number(X, X):-
   61  number(X), !.
   62ensure_number(X, Y):-
   63  atom(X), !,
   64  atom_number(X, Y).
 is_empty(+Content:atom) is semidet
   68is_empty(Content):-
   69  var(Content), !.
   70is_empty(Content):-
   71  normalize_space(atom(''), Content).
   72
   73login_link -->
   74  {http_current_request(Request)},
   75  login_link(Request).
 request_to_id(+Request, ?Kind, -Id) is semidet
True when Request is a request to the post service for the given Kind and Id. Id is '' when accessing without an id.
   82request_to_id(Request, Kind, Id) :-
   83	memberchk(path(Path), Request),
   84	(   atomic_list_concat(['',Kind,Id], '/', Path)
   85	->  true
   86	;   atom_concat(/, Kind, Path)
   87	->  Id = ''
   88	).
   89
   90true(_).
 uri_query_add(+FromURI:uri, +Name:atom, +Value:atom, -ToURI:atom) is det
Inserts the given name-value pair as a query component into the given URI.
   95uri_query_add(URI1, Name, Value, URI2):-
   96  uri_components(
   97    URI1,
   98    uri_components(Scheme, Authority, Path, Search1_, Fragment)
   99  ),
  100  (var(Search1_) -> Search1 = '' ; Search1 = Search1_),
  101  uri_query_components(Search1, SearchPairs1),
  102  add_option(SearchPairs1, Name, Value, SearchPairs2),
  103  uri_query_components(Search2, SearchPairs2),
  104  uri_components(
  105    URI2,
  106    uri_components(Scheme, Authority, Path, Search2, Fragment)
  107  ).
 wiki_file_codes_to_dom(+Codes, +File, -DOM)
DOM is the HTML dom representation for Codes that originate from File.
  114wiki_file_codes_to_dom(String, File, DOM):-
  115  nb_current(pldoc_file, OrgFile), !,
  116  setup_call_cleanup(
  117    b_setval(pldoc_file, File),
  118    wiki_codes_to_dom(String, [], DOM),
  119    b_setval(pldoc_file, OrgFile)
  120  ).
  121wiki_file_codes_to_dom(String, File, DOM):-
  122  setup_call_cleanup(
  123    b_setval(pldoc_file, File),
  124    wiki_codes_to_dom(String, [], DOM),
  125    nb_delete(pldoc_file)
  126  )