1/*   ontoweb
    2     Author: Christian Gimenez.
    3
    4     Copyright (C) 2019 Christian Gimenez
    5
    6     This program is free software: you can redistribute it and/or modify
    7     it under the terms of the GNU General Public License as published by
    8     the Free Software Foundation, either version 3 of the License, or
    9     at your option) any later version.
   10
   11     This program is distributed in the hope that it will be useful,
   12     but WITHOUT ANY WARRANTY; without even the implied warranty of
   13     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   14     GNU General Public License for more details.
   15
   16     You should have received a copy of the GNU General Public License
   17     along with this program.  If not, see <http://www.gnu.org/licenses/>.
   18
   19     03 Nov 2019
   20*/
   21
   22:- module(ontoweb, [
   23              ontoweb/1,
   24              restart_ontoweb/1
   25	  ]).

ontoweb: Web to examine RDF ontologies.

Usage:

Load any RDF or Turtle ontology and use the ontoweb/1 or restart_ontoweb/1 predicates. For example:

?- use_module(library(ontodot)).
?- load_ttl('my_ontology.ttl').
?- ontoweb(8081).

Then visit localhost:8081 to see the Web page.

author
- Christian Giménez
See also
- https://www.swi-prolog.org/howto/http/HTTPFile.html
- http://www.pathwayslms.com/swipltuts/html/index.html */
license
- GPLv3
   47:- use_module(library(ontodot)).   48
   49:- use_module(library(dcg/basics)).   50:- use_module(library(http/thread_httpd)).   51:- use_module(library(http/http_dispatch)).   52:- use_module(library(http/http_files)).   53:- use_module(library(http/http_json)).   54:- use_module(library(http/json_convert)).   55:- use_module(library(http/http_parameters)).   56:- use_module(library(http/html_write)).   57
   58:- use_module(library(prolog_pack)).   59
   60:- multifile http_json/1.   61
   62http_json:json_type('application/x-javascript').
   63http_json:json_type('text/javascript').
   64http_json:json_type('text/x-javascript').
   65http_json:json_type('text/x-json').
   66
   67
   68assert_searchpaths :-
   69    pack_property(ontoweb, directory(Dir)),
   70    atom_concat(Dir, '/prolog/css/', CSSDir),
   71    atom_concat(Dir, '/prolog/js/', JSDir),
   72    assertz(user:file_search_path(css, CSSDir)),
   73    assertz(user:file_search_path(js, JSDir)).
   74
   75html_path(Subpath, Path) :-    
   76    pack_property(ontoweb, directory(Dir)),
   77    atom_concat(Dir, '/prolog/html/', HtmlDir),
   78    atom_concat(HtmlDir, Subpath, Path).
   79
   80:- assert_searchpaths.   81
   82http:location(api, '/api', []).
   83
   84:- html_path('', Path),
   85   http_handler(root(.),
   86                http_reply_from_files(Path, []),
   87                [prefix]).   88:- http_handler(api(list_nodes), list_nodes_handler, []).   89:- http_handler(api(node_diagram), node_diagram_handler, []).   90                
   91
   92ontoweb(Port) :-
   93    http_server(http_dispatch, [port(Port)]).
   94
   95restart_ontoweb(Port) :-
   96    http_stop_server(Port, []),
   97    ontoweb(Port).
   98
   99:- json_object
  100   prefix(pref:string, suf:string) + [type=prefix].
  101:- json_object
  102   url(url:string) + [type=url].
  103
  104to_urls([], []) :- !.
  105to_urls([Pref:Suf|Rest], [prefix(Pref2, Suf2)|Rest2]) :-
  106    atom_string(Pref, Pref2),
  107    atom_string(Suf, Suf2),
  108    to_urls(Rest, Rest2).
  109to_urls([URL|Rest], [url(URL2)|Rest2]) :-
  110    atom_string(URL, URL2),
  111    to_urls(Rest, Rest2).
 list_nodes_handler(+Request:term)
Send a list of nodes. */
  118list_nodes_handler(_Request) :-
  119    list_nodes(List),
  120    to_urls(List, A),
  121    prolog_to_json(A, B),
  122    reply_json_dict(B).
  123
  124
  125generate_graph(Prefix:Suffix, Path) :-
  126    format(atom(Path), '/tmp/~w-~w.svg', [Prefix,Suffix]),
  127    dot_graph(Prefix:Suffix, Path).
  128
  129iri(Prefix, Suffix) --> string_without(":", Prefix), ":", string(Suffix), eos.
  134node_diagram_handler(Request) :-
  135    http_parameters(Request, [iri(IRI, [string])]),
  136
  137    string_codes(IRI, IRICodes),
  138    phrase(iri(Prefix, Suffix), IRICodes, []),
  139    atom_codes(PrefixA, Prefix),
  140    atom_codes(SuffixA, Suffix),
  141
  142    generate_and_send(PrefixA:SuffixA, Request).
  143
  144generate_and_send(IRI, Request) :-
  145    generate_graph(IRI, Path),
  146    
  147    % format('Content-type: text/plain~n~n'),
  148    % format('~n', [Request, IRI]).
  149    http_reply_file(Path, [unsafe(true)], Request).
  150generate_and_send(IRI, Request) :-
  151    format('Content-type: text/plain~n~n'),
  152    format('Problems generating the file for ~w. ~nRequest: ~w~n',
  153           [IRI, Request])