View source with raw comments or as raw
    1/*  Part of ClioPatria SeRQL and SPARQL server
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@uva.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2009, University of Amsterdam
    7
    8    This program is free software; you can redistribute it and/or
    9    modify it under the terms of the GNU General Public License
   10    as published by the Free Software Foundation; either version 2
   11    of the License, or (at your option) any later version.
   12
   13    This program is distributed in the hope that it will be useful,
   14    but WITHOUT ANY WARRANTY; without even the implied warranty of
   15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16    GNU General Public License for more details.
   17
   18    You should have received a copy of the GNU General Public
   19    License along with this library; if not, write to the Free Software
   20    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   21
   22    As a special exception, if you link this library with other files,
   23    compiled with a Free Software compiler, to produce an executable, this
   24    library does not by itself cause the resulting executable to be covered
   25    by the GNU General Public License. This exception does not however
   26    invalidate any other reasons why the executable file might be covered by
   27    the GNU General Public License.
   28*/
   29
   30:- module(sparql_json_result,
   31	  [ sparql_write_json_result/3	% +Out, +Result, +Options
   32	  ]).   33:- use_module(library(http/http_json)).   34:- use_module(library(sgml_write)).   35:- use_module(library(apply)).   36:- use_module(library(option)).   37:- use_module(library(semweb/rdf_db)).

Write SPARQL results as JSON

author
- Jan Wielemaker
- Michiel Hildebrand */
To be done
- Support other SPARQL request results
   46sparql_json_mime_type(application/'sparql-results+json; charset=UTF-8').
 sparql_write_json_result(+Out:stream, +Result, +Options) is det
Emit results from a SPARQL query as JSON.
See also
- http://www.w3.org/TR/rdf-sparql-json-res/
   54sparql_write_json_result(Out, select(VarTerm, Rows), Options) :-
   55	VarTerm =.. [_|VarNames],
   56	JSON = json([ head    = json([vars=VarNames]),
   57		      results = json([bindings=Bindings])
   58		    ]),
   59	maplist(row_to_json(VarNames), Rows, Bindings),
   60	(   option(content_type(_), Options)
   61	->  JSONOptions = Options
   62	;   sparql_json_mime_type(Mime),
   63	    JSONOptions = [content_type(Mime)|Options]
   64	),
   65	with_output_to(Out, reply_json(JSON, JSONOptions)).
   66sparql_write_json_result(Out, ask(True), Options) :-
   67	JSON = json([ head    = json([]),
   68		      boolean = @(True)
   69		    ]),
   70	(   option(content_type(_), Options)
   71	->  JSONOptions = Options
   72	;   sparql_json_mime_type(Mime),
   73	    JSONOptions = [content_type(Mime)|Options]
   74	),
   75	with_output_to(Out, reply_json(JSON, JSONOptions)).
   76
   77
   78row_to_json(Vars, Row, json(Bindings)) :-
   79	var_col_bindings(Vars, 1, Row, Bindings).
   80
   81var_col_bindings([], _, _, []).
   82var_col_bindings([V0|T0], I, Row, Bindings) :-
   83	arg(I, Row, Value),
   84	I2 is I + 1,
   85	(   Value = '$null$'		% also catches variables
   86	->  var_col_bindings(T0, I2, Row, Bindings)
   87	;   Bindings = [V0=json(JSON)|T],
   88	    rdf_term_to_json(Value, JSON),
   89	    var_col_bindings(T0, I2, Row, T)
   90	).
 rdf_term_to_json(+RDFTerm, -JsonTerm)
convert an rdf term to a json term.
To be done
- : Handle blank nodes.
   99rdf_term_to_json(literal(Lit), Object) :- !,
  100	Object = [type=literal, value=Txt|Rest],
  101	literal_to_json(Lit, Txt, Rest).
  102rdf_term_to_json(URI0, Object) :-
  103	rdf_global_id(URI0, URI),
  104	Object = [type=Type, value=URI],
  105	object_uri_type(URI, Type).
 literal_to_json(+Literal, -Text, -Attributes)
Extract text and Attributes from Literal resource.
  111literal_to_json(lang(Lang, Text), Text, ['xml:lang'=Lang]) :- !.
  112literal_to_json(type(Type, Text0), Text, [datatype=Type]) :- !,
  113	to_text(Type, Text0, Text).
  114literal_to_json(Txt, Txt, []).
  115
  116to_text(_Type, Text, Text) :-
  117	atomic(Text).
  118to_text(Type, DOM, Text) :-
  119	rdf_equal(Type, rdf:'XMLLiteral'), !,
  120	with_output_to(string(Text),
  121		       xml_write(DOM, [header(false)])),
  122	atomic(Text).
 object_uri_type(+URI, -Type)
Type is one of bnode or uri.
  128object_uri_type(URI, Type) :-
  129	(   rdf_is_bnode(URI)
  130	->  Type = bnode
  131	;   Type = uri
  132	).
  133
  134		 /*******************************
  135		 *   INTERACTIVE QUERY RESULT	*
  136		 *******************************/
  137
  138:- multifile
  139	rdf_io:write_table/4.  140
  141rdf_io:write_table(json, _, Rows, Options) :-
  142	memberchk(variables(Vars), Options), !,
  143	(   is_list(Vars)
  144	->  VarTerm =.. [vars|Vars]
  145	;   VarTerm = Vars
  146	),
  147	sparql_write_json_result(current_output, select(VarTerm, Rows),
  148				 [ content_type(text/plain),
  149				   Options
  150				 ])