1/* Part of sparkle
    2	Copyright 2014-2015 Samer Abdallah (UCL)
    3	 
    4	This program is free software; you can redistribute it and/or
    5	modify it under the terms of the GNU Lesser General Public License
    6	as published by the Free Software Foundation; either version 2
    7	of the License, or (at your option) any later version.
    8
    9	This program is distributed in the hope that it will be useful,
   10	but WITHOUT ANY WARRANTY; without even the implied warranty of
   11	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   12	GNU Lesser General Public License for more details.
   13
   14	You should have received a copy of the GNU Lesser General Public
   15	License along with this library; if not, write to the Free Software
   16	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
   17*/
   18
   19:- module(sparql_dcg,[
   20      select//3
   21   ,  describe//1
   22   ,  describe//2
   23   ,  ask//1
   24	]).

A simple DCG for generating a subset of SPARQL

sparql_goal ---> (sparql_goal, sparql_goal) % conjunction
               ; (sparql_goal; sparql_goal) % disjunction
               ; rdf(resource,resource,object)
               ; filter(cond)
               .

resource :< object. % any resource is an object

literal(+literal)   :: object.  % any ground literal is an object
atomic              :< literal. % any atomic can be a plain literal
lang(atom,atom)     :: literal. % literal with language
type(resource,atom) :: literal. % typed literal

object   :< expr. % any object is an expr
number   :< expr. % Prolog numerical values can also be expressions

condition ---> (cond , cond)
             ; (cond ; cond)
             ; \+ cond
             ; expr == expr
             ; expr \= expr
             ; expr >= expr
             ; expr =< expr
             ; expr < expr
             ; expr > expr
             ; between(expr,expr,expr)
             ; in(object,list(object))
             ; regex(pattern,value)
             ; bound(object)
             ; blank(resource)
             ; uri(object)
             ; literal(object)
             .

expr ---> expr + expr
        ; expr - expr
        ; expr * expr
        ; expr / expr
        ; +expr
        ; -expr
        ; str(expr)
        ; lang(expr)
        ; datatype(expr)
        .

var ---> '$VAR'(integer)
       ; '@'        % anonymous blank node
       ; '@'(atom)  % nonymous blank node
       .

var :< resource
var :< literal

Samer Abdallah, Dept. of Computer Science, UCL (2014) /

   87:- use_module(library(semweb/rdf_db), [rdf_global_object/2, rdf_global_id/2]).   88:- use_module(library(dcg_core)).   89:- use_module(library(dcg_codes)).   90
   91:- set_prolog_flag(double_quotes, codes).
 select(+Vars:list(expr), +Goal:sparql_goal, +Options:list(option))// is det
Any variables in the query must be represented by '$VAR'/1 terms as generated by numbervars/3.
   98select(Vars,Goal,Options) -->
   99   "SELECT ", 
  100   if_option(distinct(Distinct), if(Distinct=true, " DISTINCT "),Options,O1),
  101   seqmap_with_sep(" ",expr,Vars), " ",
  102   where(Goal),
  103   if_option(order_by(OB), (" ORDER BY ", expr(OB)), O1,O2),
  104   if_option(limit(Limit), (" LIMIT ", at(Limit)), O2,O3),
  105   if_option(offset(Offs), (" OFFSET ", at(Offs)), O3,O4),
  106   {check_remaining_options(O4)}.
  107
  108check_remaining_options([]) :- !.
  109check_remaining_options(Opts) :- throw(unrecognised_options(Opts)).
  110
  111if_option(Opt,Phrase,O1,O2) -->
  112   ( {select_option(Opt,O1,O2)} -> call_dcg(Phrase); {O2=O1}).
 ask(+Goal:sparql_goal)// is det
Format an ASK query.
  117ask(Goal) --> "ASK ", brace(goal(Goal)).
 describe(+Resource:resource)// is det
 describe(+Resource:resource, +Goal:sparql_goal)// is det
  122describe(R) --> "DESCRIBE ", resource(R).
  123describe(RS,Goal) --> 
  124   "DESCRIBE ", 
  125   seqmap_with_sep(" ",resource,RS),
  126   where(Goal).
 where(+Goal:sparql_goal)// is det
  129where(Goal) --> "WHERE ", brace(goal(Goal)).
 goal(+Goal)// is det
  132goal(G1;G2)   --> brace(goal(G1)), " UNION ", brace(goal(G2)).
  133goal(\+G)     --> "FILTER NOT EXISTS ", brace(goal(G)). %NB consider MINUS { ... } also
  134goal((G1,G2)) --> goal(G1), " . ", goal(G2).
  135goal(conj(GS)) --> seqmap_with_sep(" , ",goal,GS).
  136
  137goal(rdf(S,P,O)) -->
  138   { rdf_global_object(O,OO) },
  139   resource(S), " ",
  140   resource(P), " ",
  141   object(OO).
  142
  143goal(filter(Cond)) --> "FILTER ", cond(Cond).
  144
  145:- op(1150,fx,p).  146p(X) --> paren(X).
  147
  148cond(\+C)   --> p  "! ", cond(C).
  149cond((X,Y)) --> p cond(X), " && ", cond(Y).
  150cond((X;Y)) --> p cond(X), " || ", cond(Y).
  151cond(X==Y)  --> p expr(X), " = ", expr(Y).
  152cond(X\=Y)  --> p expr(X), " != ", expr(Y).
  153cond(X=<Y)  --> p expr(X), " <= ", expr(Y).
  154cond(X>=Y)  --> p expr(X), " >= ", expr(Y).
  155cond(X>Y)   --> p expr(X), " > ", expr(Y).
  156cond(X<Y)   --> p expr(X), " < ", expr(Y).
  157cond(between(L,U,X)) --> cond((L=<X,X=<U)).
  158cond(in(X,Ys))     --> p expr(X), " in ", (p seqmap_with_sep(", ",expr,Ys)).
  159cond(regex(P,V))   --> "regex(", object(V), ",", quote(at(P)), ")".
  160cond(regex(P,V,F)) --> "regex(", object(V), ",", quote(at(P)),  ",", quote(at(F)), ")".
  161cond(bound(V))     --> "bound(", object(V), ")".
  162cond(uri(V))       --> "isURI(", object(V), ")".
  163cond(blank(V))     --> "isBLANK(", object(V), ")".
  164cond(literal(V))   --> "isLITERAL(", object(V), ")".
  165
  166expr(str(V))       --> "STR(", object(V), ")".
  167expr(lang(V))      --> "LANG(", object(V), ")".
  168expr(count(X))     --> "COUNT(", expr(X), ")".
  169expr(datatype(V))  --> "DATATYPE(", object(V), ")".
  170
  171expr(+X) -->  p "+ ", expr(X), ")".
  172expr(-X) -->  p "- ", expr(X), ")".
  173expr(X+Y) --> p expr(X), " + ", expr(Y).
  174expr(X-Y) --> p expr(X), " + ", expr(Y).
  175expr(X*Y) --> p expr(X), " * ", expr(Y).
  176expr(X/Y) --> p expr(X), " / ", expr(Y).
  177expr(X) --> {number(X)}, at(X).
  178expr(X) --> object(X).
  179
  180resource(R) --> variable(R).
  181resource(R) --> {rdf_global_id(R,RR)}, uri(RR).
  182
  183object(literal(Lit)) --> literal(Lit).
  184object(Resource) --> resource(Resource).
  185
  186literal(lang(Lang,Val)) --> quote(at(Val)), "@", at(Lang).
  187literal(type(Type,Val)) --> quote(wr(Val)), "^^", resource(Type).
  188literal(Lit) --> {atomic(Lit)}, quote(at(Lit)).
  189
  190uri(U) --> {atom(U)}, "<", at(U), ">".
  191quote(P) --> "\"", escape_with(0'\\,0'",P), "\"".
  192variable(V)  --> {var_number(V,N)}, "?v", at(N).
  193variable(@V) --> "_:", {atomic(V) -> N=V; var_number(V,N)}, at(N).
  194variable(@)  --> "[]"