From 887e03a86faa42090f6841a6b15a72c367397260 Mon Sep 17 00:00:00 2001
From: Andrew Sales <andrew@andrewsales.com>
Date: Fri, 4 Aug 2023 13:57:58 +0100
Subject: [PATCH] [MOD] towards #21

---
 context.xqm            | 44 ++++++++++++++++++++++++++++--------------
 evaluate.xqm           | 43 ++++++++++++++++++++++++++++++++++-------
 svrl.xqm               | 13 +++++++++----
 test/test-evaluate.xqm |  1 +
 utils.xqm              | 12 ++++++++++++
 5 files changed, 88 insertions(+), 25 deletions(-)

diff --git a/context.xqm b/context.xqm
index 852aee1..108f836 100644
--- a/context.xqm
+++ b/context.xqm
@@ -19,11 +19,13 @@ declare variable $c:ALL_PATTERNS as xs:string := '#ALL';
  : @param instance the document instance
  : @param schema the Schematron schema
  : @param phase the active phase
+ : @param options map of options
  :)
 declare function c:get-context(
   $instance as node(),
   $schema as element(sch:schema),
-  $phase as xs:string?
+  $phase as xs:string?,
+  $options as map(*)?
 )
 as map(*)
 {
@@ -39,11 +41,15 @@ as map(*)
       $instance, 
       $namespaces, 
       $schema/sch:ns, 
-      map{}
+      map{},
+      $options
     )
     else map{}
   
-  return map{
+  return 
+  map:merge(
+    ($options,
+    map{
     'phase' : $active-phase,
     'patterns' : $active-patterns,
     'ns-decls' : $namespaces,
@@ -52,7 +58,8 @@ as map(*)
     'diagnostics' : $schema/sch:diagnostics/sch:diagnostic,
     'properties' : $schema/sch:properties/sch:property,
     'functions' : $schema/xqy:function
-  }
+    })
+  )
 };
 
 (:NAMESPACE DECLARATIONS:)
@@ -140,13 +147,15 @@ as element(sch:let)*
  : @param instance the document instance
  : @param namespaces namespace declarations
  : @param bindings global variable bindings
+ : @param options map of options
  :)
 declare function c:evaluate-global-variables(
   $variables as element(sch:let)*,
   $instance as node(),
   $namespaces as xs:string?,
   $ns-elems as element(sch:ns)*,
-  $bindings as map(*)
+  $bindings as map(*),
+  $options as map(*)?
 )
 as map(*)
 {
@@ -167,7 +176,8 @@ as map(*)
       $instance,
       $prolog || '$' || $var/@name,
       $ns-elems,
-      $bindings
+      $bindings,
+      $options
     )    
     
     (: let $_ := trace('[5]$bindings='||serialize($binding, map{'method':'adaptive'})) :)
@@ -177,7 +187,8 @@ as map(*)
       $instance,
       $namespaces,
       $ns-elems,
-      $binding
+      $binding,
+      $options
     )
 };
 
@@ -189,13 +200,15 @@ as map(*)
  : @param variables pattern variables
  : @param instance the document instance
  : @param prolog global variable and namespace declarations
+ : @param options map of options
  :)
 declare function c:evaluate-root-context-variables(
   $variables as element(sch:let)*,
   $instance as node()+,
   $namespaces as xs:string?,
   $ns-elems as element(sch:ns)*,
-  $bindings as map(*)
+  $bindings as map(*),
+  $options as map(*)?
 )
 as map(*)
 {
@@ -215,7 +228,8 @@ as map(*)
       $instance,
       $prolog ||  utils:local-variable-decls($var) || ' return $' || $var/@name,
       $ns-elems,
-      $bindings
+      $bindings,
+      $options
     )    
     
     (: let $_ := trace('[5]$bindings='||serialize($binding, map{'method':'adaptive'})) :)
@@ -225,7 +239,8 @@ as map(*)
       $instance,
       $namespaces,
       $ns-elems,
-      $binding
+      $binding,
+      $options
     )
 };
 
@@ -242,16 +257,17 @@ declare function c:evaluate-global-variable(
   $instance as node(),
   $query as xs:string?,
   $ns-elems as element(sch:ns)*,
-  $bindings as map(*)
+  $bindings as map(*),
+  $options as map(*)?
 )
 as map(*)
 {
   (: let $_ := trace('>>>QUERY='||$query) :)
   let $value as item()* := if($variable/@value) 
-    then xquery:eval(
+    then utils:eval(
       $query => utils:escape(),
       map:merge(($bindings, map{'':$instance})),
-      map{'pass':'true'}
+      map:merge($options, map{'pass':'true'})
     )
     else $variable/*
   let $bindings := map:merge(
@@ -283,7 +299,7 @@ as map(*)
 {
   if($documents) 
   then 
-    let $uris := xquery:eval(
+    let $uris := utils:eval(
       utils:make-query-prolog($context) || $documents => utils:escape(),
       map:merge(($context?globals, map{'':$context?instance})),
       map{'pass':'true'}       (:report exception details:)
diff --git a/evaluate.xqm b/evaluate.xqm
index 0ade267..888b548 100644
--- a/evaluate.xqm
+++ b/evaluate.xqm
@@ -14,6 +14,33 @@ import module namespace utils = 'http://www.andrewsales.com/ns/xqs-utils' at
 declare namespace sch = "http://purl.oclc.org/dsdl/schematron";
 declare namespace svrl = "http://purl.oclc.org/dsdl/svrl";
 
+(:~ Evaluates the schema to produce SVRL output.
+ : @param instance the document instance
+ : @param schema the Schematron schema
+ : @param phase the active phase
+ : @param options map of options
+ :)
+declare function eval:schema(
+  $instance as node(),
+  $schema as element(sch:schema),
+  $phase as xs:string?,
+  $options as map(*)?
+)
+{
+  if($options?dry-run eq 'true')
+  then  
+  <svrl:schematron-output phase='#ALL'>
+  {output:schema-title($schema/sch:title)}
+  {$schema/@schemaVersion}
+  {output:namespace-decls-as-svrl($schema/sch:ns)}
+  {for $phase in ($schema/sch:phase/@id/data(), '')
+  let $context as map(*) := context:get-context($instance, $schema, $phase, $options)
+  return eval:phase($context)}
+  </svrl:schematron-output>
+  else
+  eval:schema($instance, $schema, $phase)
+};
+
 (:~ Evaluates the schema to produce SVRL output.
  : @param instance the document instance
  : @param schema the Schematron schema
@@ -25,7 +52,7 @@ declare function eval:schema(
   $phase as xs:string?
 )
 {
-  let $context as map(*) := context:get-context($instance, $schema, $phase)
+  let $context as map(*) := context:get-context($instance, $schema, $phase, map{})
   
   return 
   <svrl:schematron-output>
@@ -57,7 +84,8 @@ declare function eval:pattern(
         $context?instance,
         $context?ns-decls,
         $pattern/../sch:ns,
-        $context?globals
+        $context?globals,
+        map{'dry-run':$context?dry-run}
       )
   (: let $_ := trace('PATTERN $globals='||serialize($globals, map{'method':'adaptive'})) :)
   let $context := map:put($context, 'globals', $globals)
@@ -122,10 +150,10 @@ as element()*
       ' '
     )
   (: let $_ := trace('[2]RULE query='||$query) :)
-  let $rule-context := xquery:eval(
+  let $rule-context := utils:eval(
     $query => utils:escape(),
     map:merge((map{'':$context?instance}, $context?globals)),
-    map{'pass':'true'} (:report exception details:)
+    map{'pass':'true', 'dry-run':$context?dry-run}
   )
   return 
   if($rule-context)
@@ -181,10 +209,10 @@ declare function eval:assertion(
   $context as map(*)
 )
 {
-  let $result := xquery:eval(
+  let $result := utils:eval(
     $prolog || $assertion/@test => utils:escape(),
     map:merge((map{'':$rule-context}, $context?globals)),
-    map{'pass':'true'}
+    map{'pass':'true', 'dry-run':$context?dry-run}
   )
   return
   typeswitch($assertion)
@@ -212,7 +240,8 @@ declare function eval:phase($context as map(*))
         $context?instance,
         $context?ns-decls,
         $phase/../sch:ns,
-        $context?globals
+        $context?globals,
+        map{'dry-run':$context?dry-run}
       )
   let $context := map:put($context, 'globals', $globals)
   
diff --git a/svrl.xqm b/svrl.xqm
index ce08e2a..335960f 100644
--- a/svrl.xqm
+++ b/svrl.xqm
@@ -3,6 +3,9 @@
  :)
 module namespace output = 'http://www.andrewsales.com/ns/xqs-output';
 
+import module namespace utils = 'http://www.andrewsales.com/ns/xqs-utils' at
+  'utils.xqm';
+
 declare namespace sch = "http://purl.oclc.org/dsdl/schematron";
 declare namespace svrl = "http://purl.oclc.org/dsdl/svrl";
 
@@ -113,15 +116,17 @@ declare function output:assertion-message-content(
     typeswitch($node)
       case element(sch:name)
         return if($node/@path) 
-          then xquery:eval(
+          then utils:eval(
             $prolog || $node/@path, 
-            map:merge((map{'':$rule-context}, $context?globals))
+            map:merge((map{'':$rule-context}, $context?globals)),
+            map{'pass':'true'}
           ) 
           else name($rule-context)
       case element(sch:value-of)
-        return xquery:eval(
+        return utils:eval(
           $prolog || $node/@select, 
-          map:merge((map{'':$rule-context}, $context?globals))
+          map:merge((map{'':$rule-context}, $context?globals)),
+          map{'pass':'true'}
         ) 
         => string()
       case element(sch:emph)
diff --git a/test/test-evaluate.xqm b/test/test-evaluate.xqm
index dc1b87e..631111d 100644
--- a/test/test-evaluate.xqm
+++ b/test/test-evaluate.xqm
@@ -814,6 +814,7 @@ declare %unit:test function _:global-variable-bindings()
     document{<foo bar='some value'><blort/></foo>},
     '',
     (),
+    map{},
     map{}
   )
   return (
diff --git a/utils.xqm b/utils.xqm
index 907717b..e17486a 100644
--- a/utils.xqm
+++ b/utils.xqm
@@ -124,3 +124,15 @@ declare function utils:check-duplicate-variable-names($decls as element(sch:let)
     || $names[index-of($names, .)[2]]
   ) else()
 };
+
+(:~ Wrapper around xquery:eval() :)
+declare function utils:eval(
+  $query as xs:string,
+  $bindings as map(*),
+  $options as map(*)
+) as item()*
+{
+  if($options?dry-run eq 'true')
+  then ()
+  else xquery:eval($query, $bindings, map{'pass':'true'})
+};
\ No newline at end of file