View source with raw comments or as raw
   1/*  Part of SWI-Prolog
   2
   3    Author:        Jan Wielemaker
   4    E-mail:        J.Wielemaker@vu.nl
   5    WWW:           http://www.swi-prolog.org
   6    Copyright (c)  2009-2012, University of Amsterdam
   7                              VU University Amsterdam
   8    All rights reserved.
   9
  10    Redistribution and use in source and binary forms, with or without
  11    modification, are permitted provided that the following conditions
  12    are met:
  13
  14    1. Redistributions of source code must retain the above copyright
  15       notice, this list of conditions and the following disclaimer.
  16
  17    2. Redistributions in binary form must reproduce the above copyright
  18       notice, this list of conditions and the following disclaimer in
  19       the documentation and/or other materials provided with the
  20       distribution.
  21
  22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
  28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
  32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  33    POSSIBILITY OF SUCH DAMAGE.
  34*/
  35
  36:- module(rdf_portray,
  37          [ rdf_portray_as/1,           % +Style
  38            rdf_portray_lang/1          % +Lang
  39          ]).
  40:- use_module(library(semweb/rdf_db)).
  41:- use_module(library(semweb/rdfs)).
  42:- use_module(library(error)).
  43
  44/** <module> Portray RDF resources
  45
  46This module defines  rules  for  user:portray/1   to  help  tracing  and
  47debugging  RDF  resources  by  printing   them    in   a   more  concise
  48representation and optionally adding comment  from   the  label field to
  49help the user interpreting the URL. The main predicates are:
  50
  51        * rdf_portray_as/1 defines the overall style
  52        * rdf_portray_lang/1 selects languages for extracting label comments
  53
  54@tbd    Define alternate predicate to use for providing a comment
  55@tbd    Use rdf:type if there is no meaningful label?
  56@tbd    Smarter guess whether or not the local identifier might be
  57        meaningful to the user without a comment.  I.e. does it look
  58        `word-like'?
  59*/
  60
  61:- dynamic
  62    style/1,
  63    lang/1.
  64
  65%!  rdf_portray_as(+Style) is det.
  66%
  67%   Set the style used to portray resources.  Style is one of:
  68%
  69%           $ =|prefix:id|= :
  70%           Write as NS:ID, compatible with what can be handed to
  71%           the rdf predicates.  This is the default.
  72%
  73%           $ =writeq= :
  74%           Use quoted write of the full resource.
  75%
  76%           $ =|prefix:label|= :
  77%           Write namespace followed by the label.  This format
  78%           cannot be handed to rdf/3 and friends, but can be
  79%           useful if resource-names are meaningless identifiers.
  80%
  81%           $ =|prefix:id=label|= :
  82%           This combines prefix:id with prefix:label, providing both human
  83%           readable output and output that can be pasted into the
  84%           commandline.
  85
  86rdf_portray_as(Style) :-
  87    must_be(oneof([writeq, prefix:id, prefix:label, prefix:id=label]), Style),
  88    retractall(style(_)),
  89    assert(style(Style)).
  90
  91%!  rdf_portray_lang(+Lang) is det.
  92%
  93%   If Lang is a list, set the list or preferred languages. If it is
  94%   a  single  atom,  push  this  language  as  the  most  preferred
  95%   language.
  96
  97rdf_portray_lang(Lang) :-
  98    (   is_list(Lang)
  99    ->  must_be(list(atom), Lang),
 100        retractall(lang(_)),
 101        forall(member(L,Lang), assert(lang(L)))
 102    ;   must_be(atom, Lang),
 103        asserta(lang(Lang))
 104    ).
 105
 106try_lang(L) :- lang(L).
 107try_lang(_).
 108
 109
 110:- multifile
 111    user:portray/1.
 112
 113user:portray(URL) :-
 114    atom(URL),
 115    sub_atom(URL, 0, _, _, 'http://'),
 116    !,
 117    (   style(Style)
 118    ->  true
 119    ;   Style = prefix:id
 120    ),
 121    portray_url(Style, URL).
 122user:portray(URL) :-
 123    atom(URL),
 124    atom_concat('_:file://', URL2, URL),
 125    sub_atom(URL2, S, _, A, #),
 126    sub_atom(URL2, _, A, 0, Local),
 127    sub_atom(URL2, 0, S, _, Path),
 128    file_base_name(Path, Base),
 129    format('_:~w#~w', [Base, Local]).
 130
 131portray_url(writeq, URL) :-
 132    writeq(URL).
 133portray_url(prefix:id, URL) :-
 134    (   rdf_global_id(NS:Id, URL)
 135    ->  writeq(NS:Id)
 136    ;   writeq(URL)
 137    ).
 138portray_url(prefix:id=label, URL) :-
 139    (   rdf_global_id(NS:Id, URL)
 140    ->  Value = NS:Id
 141    ;   Value = URL
 142    ),
 143    (   Id \== '',
 144        (   (   try_lang(Lang),
 145                rdf_has(URL, rdfs:label, literal(lang(Lang, Label)))
 146            ->  nonvar(Lang),
 147                \+ label_is_id(Label, Id)
 148            )
 149        ->  format('~q/*"~w"@~w*/', [Value, Label, Lang])
 150        ;   rdf_has(URL, rdfs:label, literal(type(Type, Label))),
 151            nonvar(Type),
 152            \+ label_is_id(Label, Id)
 153        ->  (   rdf_global_id(TNS:TId, Type)
 154            ->      TVal = TNS:TId
 155            ;       TVal = Type
 156            ),
 157            format('~q/*"~w"^^~w*/', [Value, Label, TVal])
 158        ;   rdf_has(URL, rdfs:label, literal(Label)),
 159            atom(Label),
 160            Label \== Id
 161        ->  format('~q/*"~w"*/', [Value, Label])
 162        )
 163    ->  true
 164    ;   writeq(Value)
 165    ).
 166portray_url(prefix:label, URL) :-
 167    rdfs_ns_label(URL, Label),
 168    write(Label).
 169
 170label_is_id(_, Var) :-
 171    var(Var), !, fail.
 172label_is_id(Label, Label) :- !.
 173label_is_id(L0, L1) :-
 174    downcase_atom(L0, Lwr),
 175    downcase_atom(L1, Lwr).