forked from AndrewSales/XQS
-
Notifications
You must be signed in to change notification settings - Fork 0
/
svrl.xqm
135 lines (127 loc) · 3.68 KB
/
svrl.xqm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
(:~
: Conveniences for assembling SVRL output.
:)
module namespace output = 'http://www.andrewsales.com/ns/xqs-output';
declare namespace sch = "http://purl.oclc.org/dsdl/schematron";
declare namespace svrl = "http://purl.oclc.org/dsdl/svrl";
declare function output:schema-title($title as element(sch:title)?)
as attribute(title)?
{
if($title) then attribute{'title'}{$title} else ()
};
declare function output:namespace-decls-as-svrl($nss as element(sch:ns)*)
as element(svrl:ns-prefix-in-attribute-values)*
{
for $ns in $nss
return
<svrl:ns-prefix-in-attribute-values>
{$ns/@prefix, $ns/@uri}
</svrl:ns-prefix-in-attribute-values>
};
(:~ Outputs a failed-assert or successful-report element. :)
declare function output:assertion-message(
$assertion as element(),
$prolog as xs:string?,
$rule-context as node(),
$context as map(*)
)
{
element{
QName("http://purl.oclc.org/dsdl/svrl",
if($assertion/self::sch:assert) then 'failed-assert' else 'successful-report')}
{
attribute{'location'}{path($rule-context)},
$assertion/(@id, @role, @flag, @test),
output:diagnostics(
$context?diagnostics[@id = tokenize($assertion/@diagnostics)],
$prolog,
$rule-context,
$context
),
output:properties(
$context?properties[@id = tokenize($assertion/@properties)],
$prolog,
$rule-context,
$context
),
output:assertion-message-content(
$assertion/node(),
$prolog,
$rule-context,
$context
)
}
};
(:~ Transforms SCH namespace to SVRL. (Not attempting to address inconsistencies
: between schema and SVRL elements and attributes.)
:)
declare function output:assertion-child-elements($element as element())
as element()
{
element{QName("http://purl.oclc.org/dsdl/svrl", local-name($element))}
{$element/@*, $element/node()}
};
declare function output:diagnostics(
$diagnostics as element(sch:diagnostic)*,
$prolog as xs:string?,
$rule-context as node(),
$context as map(*)
)
as element(svrl:diagnostic-reference)*
{
$diagnostics !
<svrl:diagnostic-reference diagnostic='{@id}'>
{output:assertion-message-content(node(), $prolog, $rule-context, $context)}
</svrl:diagnostic-reference>
};
declare function output:properties(
$properties as element(sch:property)*,
$prolog as xs:string?,
$rule-context as node(),
$context as map(*)
)
as element(svrl:property-reference)*
{
$properties !
<svrl:property-reference property='{@id}'>
{@role, @scheme,
output:assertion-message-content(node(), $prolog, $rule-context, $context)}
</svrl:property-reference>
};
(:~ Outputs svrl:text, which corresponds to the model <code>human-text</code>
: in the SVRL schema.
: @see ISO2020, Annex D
:)
declare function output:assertion-message-content(
$content as node()*,
$prolog as xs:string?,
$rule-context as node(),
$context as map(*)
)
{
<svrl:text>{(:TODO attributes:)
for $node in $content
return
typeswitch($node)
case element(sch:name)
return if($node/@path)
then xquery:eval(
$prolog || $node/@path,
map:merge((map{'':$rule-context}, $context?globals))
)
else name($rule-context)
case element(sch:value-of)
return xquery:eval(
$prolog || $node/@select,
map:merge((map{'':$rule-context}, $context?globals))
)
=> string()
case element(sch:emph)
return output:assertion-child-elements($node)
case element(sch:dir)
return output:assertion-child-elements($node)
case element(sch:span)
return output:assertion-child-elements($node)
default return $node
}</svrl:text>
};