Small tweaks to signatures

Small tweaks to signatures

xquery version "3.1";

(:~ Origami μ-templates :)

(: TODO: add XML serialization options :)
(: TODO: add option to move all ns declarations at document element (sane namespaces) !? :)
(: TODO: better json serialization :)
(: TODO: remove args from :xml :)
(: TODO: can we scan $items for function items and if so return a function automatically? :)

(: DONE: add ways to configure how names are mapped to qnames (e.g. define a mapping a la JSON-LD) :)
(: DONE: add default element namespace :)

module namespace μ = 'http://xokomola.com/xquery/origami/μ';

declare function μ:xml($items as item()*)
as node()*
{
    μ:xml($items, [], μ:qname-resolver())
};

declare function μ:xml($items as item()*, $resolver-or-args as function(*))
as node()*
{
    if ($resolver-or-args instance of array(*)) then
        μ:xml($items, $resolver-or-args, μ:qname-resolver())
    else
        μ:xml($items, [], $resolver-or-args)
};

declare function μ:xml($items as item()*, $args as array(*), $name-resolver as function(*))
as node()*
{
    μ:to-xml($items, $args, $name-resolver)
};

declare function μ:json($items as item()*)
as xs:string
{
    μ:json($items, [], function($name) { $name })
};

declare function μ:json($items as item()*, $resolver-or-args as function(*))
as xs:string
{
    if ($resolver-or-args instance of array(*)) then
        μ:json($items, $resolver-or-args, μ:qname-resolver())
    else
        μ:json($items, [], $resolver-or-args)
};

declare function μ:json($items as item()*, $args as array(*), $name-resolver as function(*))
as xs:string
{
    serialize(μ:to-json(if (count($items) gt 1) then array { $items } else $items, $args, $name-resolver), map { 'method': 'json' })
};

declare function μ:mu($xml)
{
    μ:from-xml($xml)
};

declare %private function μ:to-json($items as item()*, $args as array(*), $name-resolver as function(*))
{
    for $item in $items
    return
        typeswitch ($item)
        case array(*)
        return
            array:fold-left($item, [],
                function($a,$b) {
                    if (count($b) gt 1) then
                        (: splice the sequence into the array to avoid JSON
                         : serialization error :)
                        array:join((
                            $a,
                            fold-left($b, [],
                                function($c,$d) {
                                    array:append($c, μ:to-json($d, $args, $name-resolver))
                                })
                        ))
                    else
                        array:append($a, μ:to-json($b, $args, $name-resolver))
                }
            )
        case map(*)
        return
            map:merge(
                map:for-each($item,
                    function($a,$b) {
                        map:entry($a, μ:to-json($b, $args, $name-resolver)) }))
        case function(*) return μ:to-json(apply($item, $args), $args, $name-resolver)
        case node() return μ:from-xml($item)
        default return $item
};

declare %private function μ:from-xml($xml)
as item()*
{
    for $node in $xml
    return
        typeswitch($node)
        case element()
        return
            array {
                name($node),
                if ($node/@*) then
                    map:merge((
                        for $a in $node/@*
                        return map:entry(name($a), data($a))))
                else
                    (),
                μ:from-xml($node/node())
            }
        case comment() | processing-instruction() return ()
        default return string($node)
};

declare %private function μ:to-xml($items as item()*, $args as array(*), $name-resolver as function(*))
as node()*
{
    for $item in $items
    return
        typeswitch ($item)
        case array(*) return μ:to-element($item, $args, $name-resolver)
        case map(*) return  μ:to-attributes($item, $args, $name-resolver)
        case function(*) return μ:to-xml(apply($item, $args), $args, $name-resolver)
        case empty-sequence() return ()
        case node() return $item
        default return text { $item }
};

declare %private function μ:to-element($item as array(*), $args as array(*), $name-resolver as function(*))
as element()?
{
    if (array:size($item) gt 0) then
        element { $name-resolver(array:head($item)) } {
            array:fold-left(
                array:tail($item),
                (),
                function($n, $i) {
                    ($n, μ:to-xml($i, $args, $name-resolver))
                }
            )
        }
    else
        ()
};

declare %private function μ:to-attributes($item as map(*), $args as array(*), $name-resolver as function(*))
as attribute()*
{
    map:for-each($item,
        function($k,$v) {
            if (not(starts-with($k,'μ:'))) then
                attribute { $name-resolver($k) } {
                    data(
                        typeswitch ($v)
                        case function(*)
                        return apply($v, $args)
                        default
                        return $v
                    ) }
            else
                ()
        })
};

declare function μ:qname-resolver()
as function(xs:string) as xs:QName
{
    μ:qname(?, μ:ns(), ())
};

declare function μ:qname-resolver($ns-map as map(*))
as function(xs:string) as xs:QName
{
    μ:qname(?, $ns-map, ())
};

declare function μ:qname-resolver($ns-map as map(*), $default-ns as xs:string)
as function(xs:string) as xs:QName
{
    μ:qname(?, $ns-map, $default-ns)
};

(:~
 : As XQuery doesn't allow access to namespace nodes (as XSLT does)
 : construct them indirectly via QName#2.
 :)
declare function μ:qname($name as xs:string, $ns-map as map(*))
as xs:QName
{
    μ:qname($name, $ns-map, ())
};

declare function μ:qname($name as xs:string, $ns-map as map(*), $default-ns as xs:string?)
as xs:QName
{
    if (contains($name, ':')) then
        let $prefix := substring-before($name,':')
        let $local := substring-after($name, ':')
        let $ns := $ns-map($prefix)
        return
            if ($ns = $default-ns) then
                QName($ns, $local)
            else
                QName($ns, concat($prefix,':',$local))
    else
        if ($default-ns) then
            QName($default-ns, $name)
        else
            QName((), $name)
};

declare function μ:ns()
as map(*)
{
    μ:ns(map {})
};

declare function μ:ns($ns-map as map(*))
as map(*)
{
    map:merge((
        $ns-map,
        for $ns in doc(concat(file:base-dir(),'/nsmap.xml'))/nsmap/*
        return
            map:entry(string($ns/@prefix), string($ns/@uri))
    ))
};

declare function μ:cons($a,$b)
as item()*
{
    ($a,$b)
};

declare function μ:head($mu as array(*)?)
as item()*
{
    if (empty($mu)) then
        ()
    else
        array:head($mu)
};

declare function μ:tail($mu as array(*)?)
as item()*
{
    if (not(empty($mu))) then
        tail(μ:seq($mu))
    else
        ()
};

(:~
 : Remove level of array and change it into a normal sequence.
 :)
declare function μ:seq($mu as array(*))
as item()*
{
    typeswitch ($mu)
        case array(*)
            return array:fold-left($mu, (), μ:cons#2)
        default
            return $mu
};

declare function μ:content($mu)
as item()*
{
    typeswitch($mu)
    case array(*)
    return
        let $c := array:tail($mu)
        return
            if (array:head($c) instance of map(*)) then
                array:tail($c)
            else
                $c
    default
    return $mu/node()
};

xquery version "3.1";

(:~ Origami μ-templates :)

(: TODO: add XML serialization options :)
(: TODO: add option to move all ns declarations at document element (sane namespaces) !? :)
(: TODO: better json serialization :)
(: TODO: remove args from :xml :)
(: TODO: can we scan $items for function items and if so return a function automatically? :)

(: DONE: add ways to configure how names are mapped to qnames (e.g. define a mapping a la JSON-LD) :)
(: DONE: add default element namespace :)

module namespace μ = 'http://xokomola.com/xquery/origami/μ';

declare function μ:xml($items as item()*)
{
    μ:xml($items, [], μ:qname-resolver())
};

declare function μ:xml($items as item()*, $resolver-or-args as function(*))
as node()*
{
    if ($resolver-or-args instance of array(*)) then
        μ:xml($items, $resolver-or-args, μ:qname-resolver())
    else
        μ:xml($items, [], $resolver-or-args)
};

declare function μ:xml($items as item()*, $args as array(*), $name-resolver as function(*))
as node()*
{
    μ:to-xml($items, $args, $name-resolver)
};

declare function μ:json($items as item()*)
{
    μ:json($items, [], function($name) { $name })
};

declare function μ:json($items as item()*, $resolver-or-args as function(*))
as node()*
{
    if ($resolver-or-args instance of array(*)) then
        μ:json($items, $resolver-or-args, μ:qname-resolver())
    else
        μ:json($items, [], $resolver-or-args)
};

declare function μ:json($items as item()*, $args as array(*), $name-resolver as function(*))
{
    serialize(μ:to-json(if (count($items) gt 1) then array { $items } else $items, $args, $name-resolver), map { 'method': 'json' })
};

declare function μ:mu($xml)
{
    μ:from-xml($xml)
};

declare %private function μ:to-json($items as item()*, $args as array(*), $name-resolver as function(*))
{
    for $item in $items
    return
        typeswitch ($item)
        case array(*)
        return
            array:fold-left($item, [],
                function($a,$b) {
                    if (count($b) gt 1) then
                        (: splice the sequence into the array to avoid JSON
                         : serialization error :)
                        array:join((
                            $a,
                            fold-left($b, [],
                                function($c,$d) {
                                    array:append($c, μ:to-json($d, $args, $name-resolver))
                                })
                        ))
                    else
                        array:append($a, μ:to-json($b, $args, $name-resolver))
                }
            )
        case map(*)
        return
            map:merge(
                map:for-each($item,
                    function($a,$b) {
                        map:entry($a, μ:to-json($b, $args, $name-resolver)) }))
        case function(*) return μ:to-json(apply($item, $args), $args, $name-resolver)
        case node() return μ:from-xml($item)
        default return $item
};

declare %private function μ:from-xml($xml)
as item()*
{
    for $node in $xml
    return
        typeswitch($node)
        case element()
        return
            array {
                name($node),
                if ($node/@*) then
                    map:merge((
                        for $a in $node/@*
                        return map:entry(name($a), data($a))))
                else
                    (),
                μ:from-xml($node/node())
            }
        case comment() | processing-instruction() return ()
        default return string($node)
};

declare %private function μ:to-xml($items as item()*, $args as array(*), $name-resolver as function(*))
as node()*
{
    for $item in $items
    return
        typeswitch ($item)
        case array(*) return μ:to-element($item, $args, $name-resolver)
        case map(*) return  μ:to-attributes($item, $args, $name-resolver)
        case function(*) return μ:to-xml(apply($item, $args), $args, $name-resolver)
        case empty-sequence() return ()
        case node() return $item
        default return text { $item }
};

declare %private function μ:to-element($item as array(*), $args as array(*), $name-resolver as function(*))
as element()?
{
    if (array:size($item) gt 0) then
        element { $name-resolver(array:head($item)) } {
            array:fold-left(
                array:tail($item),
                (),
                function($n, $i) {
                    ($n, μ:to-xml($i, $args, $name-resolver))
                }
            )
        }
    else
        ()
};

declare %private function μ:to-attributes($item as map(*), $args as array(*), $name-resolver as function(*))
as attribute()*
{
    map:for-each($item,
        function($k,$v) {
            if (not(starts-with($k,'μ:'))) then
                attribute { $name-resolver($k) } {
                    data(
                        typeswitch ($v)
                        case function(*)
                        return apply($v, $args)
                        default
                        return $v
                    ) }
            else
                ()
        })
};

declare function μ:qname-resolver()
as function(xs:string) as xs:QName
{
    μ:qname(?, μ:ns(), ())
};

declare function μ:qname-resolver($ns-map as map(*))
as function(xs:string) as xs:QName
{
    μ:qname(?, $ns-map, ())
};

declare function μ:qname-resolver($ns-map as map(*), $default-ns as xs:string)
as function(xs:string) as xs:QName
{
    μ:qname(?, $ns-map, $default-ns)
};

(:~
 : As XQuery doesn't allow access to namespace nodes (as XSLT does)
 : construct them indirectly via QName#2.
 :)
declare function μ:qname($name as xs:string, $ns-map as map(*))
as xs:QName
{
    μ:qname($name, $ns-map, ())
};

declare function μ:qname($name as xs:string, $ns-map as map(*), $default-ns as xs:string?)
as xs:QName
{
    if (contains($name, ':')) then
        let $prefix := substring-before($name,':')
        let $local := substring-after($name, ':')
        let $ns := $ns-map($prefix)
        return
            if ($ns = $default-ns) then
                QName($ns, $local)
            else
                QName($ns, concat($prefix,':',$local))
    else
        if ($default-ns) then
            QName($default-ns, $name)
        else
            QName((), $name)
};

declare function μ:ns()
as map(*)
{
    μ:ns(map {})
};

declare function μ:ns($ns-map as map(*))
as map(*)
{
    map:merge((
        $ns-map,
        for $ns in doc(concat(file:base-dir(),'/nsmap.xml'))/nsmap/*
        return
            map:entry(string($ns/@prefix), string($ns/@uri))
    ))
};

declare function μ:cons($a,$b)
as item()*
{
    ($a,$b)
};

declare function μ:head($mu as array(*)?)
as item()*
{
    if (empty($mu)) then
        ()
    else
        array:head($mu)
};

declare function μ:tail($mu as array(*)?)
as item()*
{
    if (not(empty($mu))) then
        tail(μ:seq($mu))
    else
        ()
};

(:~
 : Remove level of array and change it into a normal sequence.
 :)
declare function μ:seq($mu as array(*))
as item()*
{
    typeswitch ($mu)
        case array(*)
            return array:fold-left($mu, (), μ:cons#2)
        default
            return $mu
};

declare function μ:content($mu)
as item()*
{
    typeswitch($mu)
    case array(*)
    return
        let $c := array:tail($mu)
        return
            if (array:head($c) instance of map(*)) then
                array:tail($c)
            else
                $c
    default
    return $mu/node()
};


[ignore] made menu entries more consistent. need to sort ?

svn path=/trunk/eXist/; revision=9943

xquery version "1.0";
(: $Id$ :)
(:
    Main module of the database administration interface.
:)

declare namespace admin = "http://exist-db.org/xquery/admin-interface";

declare namespace request = "http://exist-db.org/xquery/request";
declare namespace session = "http://exist-db.org/xquery/session";
declare namespace util = "http://exist-db.org/xquery/util";
declare namespace xdb = "http://exist-db.org/xquery/xmldb";

import module namespace status = "http://exist-db.org/xquery/admin-interface/status" at "status.xqm";
import module namespace browse = "http://exist-db.org/xquery/admin-interface/browse" at "browse.xqm";
import module namespace users = "http://exist-db.org/xquery/admin-interface/users" at "users.xqm";
import module namespace xqueries = "http://exist-db.org/xquery/admin-interface/xqueries" at "xqueries.xqm";
import module namespace shut = "http://exist-db.org/xquery/admin-interface/shutdown" at "shutdown.xqm";
import module namespace setup = "http://exist-db.org/xquery/admin-interface/setup" at "setup.xqm";
import module namespace rev="http://exist-db.org/xquery/admin-interface/revisions" at "versions.xqm";
import module namespace backup="http://exist-db.org/xquery/admin-interface/backup" at "backup.xqm";
import module namespace prof="http://exist-db.org/xquery/profiling" at "trace.xqm";

declare option exist:serialize "method=xhtml media-type=text/html";

(:
    Display the version, SVN revision and user info in the top right corner
:)
declare function admin:info-header() as element()
{

Version: { util:system-property( "product-version" ) }

SVN Revision: { util:system-property( "svn-revision" ) }

Build: {util:system-property("product-build")}

User: { xdb:get-current-user() }

};

(:
    Select the page to show. Every page is defined in its own module
:)
declare function admin:panel() as element()
{
    let $panel := request:get-parameter("panel", "status") return
        if($panel eq "browse") then
        (
            browse:main()
        )
        else if($panel eq "users") then
        (
            users:main()
        )
         else if($panel eq "xqueries") then
        (
            xqueries:main()
        )
        else if($panel eq "shutdown") then
        (
            shut:main()
        )
        else if($panel eq "setup") then
        (
            setup:main()
        )
		else if ($panel eq "revisions") then
		(
			rev:main()
		)
		else if ($panel eq "backup") then
		    backup:main()
	    else if ($panel eq "trace") then
	        prof:main()
        else
        (
            status:main()
        )
};

(:~
    Display the login form.
:)
declare function admin:display-login-form() as element()
{

Login

This is a protected resource. Only registered database users can log
        in. If you have not set up any users, login as "admin" and leave the
        password field empty. Note that the "guest" user is not permitted access.

        <form action="{session:encode-url(request:get-uri())}" method="post">

                    Please Login

                    Username:
                    <input name="user" type="text" size="20"/>

                    Password:
                    <input name="pass" type="password" size="20"/>

                    <input type="submit"/>

        </form>

};

(: main entry point :)
let $isLoggedIn :=  if(xdb:get-current-user() eq "guest")then
    (
        (: is this a login attempt? :)
        if(request:get-parameter("user", ()) and not(empty(request:get-parameter("pass", ()))))then
        (
            if(request:get-parameter("user", ()) eq "guest")then
            (
                (: prevent the guest user from accessing the admin webapp :)
                false()
            )
            else
            (
                (: try and log the user in :)
                xdb:login( "/db", request:get-parameter("user", ()), request:get-parameter("pass", () ), true() )
            )
        )
        else
        (
            (: prevent the guest user from accessing the admin webapp :)
            false()
        )
    )
    else
    (
        (: if we are already logged in, are we logging out - i.e. set permissions back to guest :)
        if(request:get-parameter("logout",()))then
        (
        	let $null  := xdb:login("/db", "guest", "guest")
            let $inval := session:invalidate()

            return false()
        )
        else
        (
             (: we are already logged in and we are not the guest user :)
            true()
        )
    )
return

            <title>eXist Database Administration</title>
            <link type="text/css" href="admin.css" rel="stylesheet"/>
			<link type="text/css" href="styles/prettify.css" rel="stylesheet"/>
			<link type="text/css" href="../scripts/yui/yui-skin.css" rel="stylesheet"/>
            <link rel="shortcut icon" href="../resources/exist_icon_16x16.ico"/>
			<link rel="icon" href="../resources/exist_icon_16x16.png" type="image/png"/>

                {admin:info-header()}

Select a Page

Home

System Status

Browse Collections

User Management

View Running Jobs

Examples Setup

Backups

Query Profiling

Shutdown

Logout

                        Logged in as: {xdb:get-current-user()}

                {
                    if($isLoggedIn)then
                    (
                        admin:panel()
                    )
                    else
                    (
                        admin:display-login-form()
                    )
                }

xquery version "1.0";
(: $Id$ :)
(:
    Main module of the database administration interface.
:)

declare namespace admin = "http://exist-db.org/xquery/admin-interface";

declare namespace request = "http://exist-db.org/xquery/request";
declare namespace session = "http://exist-db.org/xquery/session";
declare namespace util = "http://exist-db.org/xquery/util";
declare namespace xdb = "http://exist-db.org/xquery/xmldb";

import module namespace status = "http://exist-db.org/xquery/admin-interface/status" at "status.xqm";
import module namespace browse = "http://exist-db.org/xquery/admin-interface/browse" at "browse.xqm";
import module namespace users = "http://exist-db.org/xquery/admin-interface/users" at "users.xqm";
import module namespace xqueries = "http://exist-db.org/xquery/admin-interface/xqueries" at "xqueries.xqm";
import module namespace shut = "http://exist-db.org/xquery/admin-interface/shutdown" at "shutdown.xqm";
import module namespace setup = "http://exist-db.org/xquery/admin-interface/setup" at "setup.xqm";
import module namespace rev="http://exist-db.org/xquery/admin-interface/revisions" at "versions.xqm";
import module namespace backup="http://exist-db.org/xquery/admin-interface/backup" at "backup.xqm";
import module namespace prof="http://exist-db.org/xquery/profiling" at "trace.xqm";

declare option exist:serialize "method=xhtml media-type=text/html";

(:
    Display the version, SVN revision and user info in the top right corner
:)
declare function admin:info-header() as element()
{

Version: { util:system-property( "product-version" ) }

SVN Revision: { util:system-property( "svn-revision" ) }

Build: {util:system-property("product-build")}

User: { xdb:get-current-user() }

};

(:
    Select the page to show. Every page is defined in its own module
:)
declare function admin:panel() as element()
{
    let $panel := request:get-parameter("panel", "status") return
        if($panel eq "browse") then
        (
            browse:main()
        )
        else if($panel eq "users") then
        (
            users:main()
        )
         else if($panel eq "xqueries") then
        (
            xqueries:main()
        )
        else if($panel eq "shutdown") then
        (
            shut:main()
        )
        else if($panel eq "setup") then
        (
            setup:main()
        )
		else if ($panel eq "revisions") then
		(
			rev:main()
		)
		else if ($panel eq "backup") then
		    backup:main()
	    else if ($panel eq "trace") then
	        prof:main()
        else
        (
            status:main()
        )
};

(:~
    Display the login form.
:)
declare function admin:display-login-form() as element()
{

Login

This is a protected resource. Only registered database users can log
        in. If you have not set up any users, login as "admin" and leave the
        password field empty. Note that the "guest" user is not permitted access.

        <form action="{session:encode-url(request:get-uri())}" method="post">

                    Please Login

                    Username:
                    <input name="user" type="text" size="20"/>

                    Password:
                    <input name="pass" type="password" size="20"/>

                    <input type="submit"/>

        </form>

};

(: main entry point :)
let $isLoggedIn :=  if(xdb:get-current-user() eq "guest")then
    (
        (: is this a login attempt? :)
        if(request:get-parameter("user", ()) and not(empty(request:get-parameter("pass", ()))))then
        (
            if(request:get-parameter("user", ()) eq "guest")then
            (
                (: prevent the guest user from accessing the admin webapp :)
                false()
            )
            else
            (
                (: try and log the user in :)
                xdb:login( "/db", request:get-parameter("user", ()), request:get-parameter("pass", () ), true() )
            )
        )
        else
        (
            (: prevent the guest user from accessing the admin webapp :)
            false()
        )
    )
    else
    (
        (: if we are already logged in, are we logging out - i.e. set permissions back to guest :)
        if(request:get-parameter("logout",()))then
        (
        	let $null  := xdb:login("/db", "guest", "guest")
            let $inval := session:invalidate()

            return false()
        )
        else
        (
             (: we are already logged in and we are not the guest user :)
            true()
        )
    )
return

            <title>eXist Database Administration</title>
            <link type="text/css" href="admin.css" rel="stylesheet"/>
			<link type="text/css" href="styles/prettify.css" rel="stylesheet"/>
			<link type="text/css" href="../scripts/yui/yui-skin.css" rel="stylesheet"/>
            <link rel="shortcut icon" href="../resources/exist_icon_16x16.ico"/>
			<link rel="icon" href="../resources/exist_icon_16x16.png" type="image/png"/>

                {admin:info-header()}

Select a Page

Home

System Status

Browse Collections

Manage Users

						View Running Jobs

Examples Setup

Backups

Profiling

Shutdown

Logout

                        Logged in as: {xdb:get-current-user()}

                {
                    if($isLoggedIn)then
                    (
                        admin:panel()
                    )
                    else
                    (
                        admin:display-login-form()
                    )
                }


Added missing "return".

Added missing "return".

(: try parsing an empty value :)

import module namespace json = "http://www.zorba-xquery.com/modules/converters/json";

let $options :=
  <options xmlns="http://www.zorba-xquery.com/modules/converters/json-options">
    <json-format value="JsonML-array"/>
  </options>

return json:parse(<a/>,$options)

(: try parsing an empty value :)

import module namespace json = "http://www.zorba-xquery.com/modules/converters/json";

let $options :=
  <options xmlns="http://www.zorba-xquery.com/modules/converters/json-options">
    <json-format value="JsonML-array"/>
  </options>

json:parse(<a/>,$options)


moved to all reference to db being in csd_webconf instead of a variable so we can let basex optimize

import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";

import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";

import module namespace mhero = "https://github.com/openhie/openinfoman-mhero";

declare namespace csd  =  "urn:ihe:iti:csd:2013";

declare variable $careServicesRequest as item() external;

let $mhero_doc := /.
let $mhero := $careServicesRequest/@resource
let $mhero := $careServicesRequest/documents/mhero/@resource

for $doc  in $careServicesRequest/documents/document
let $name := $doc/@resource
let $src_doc :=
  if (not ($name  = ''))
  then if (not ($name = $mhero)) then csd_dm:open_document( $name) else ()
  else $doc
return mhero:merge_into($mhero_doc, $src_doc)

import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";

import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";

import module namespace mhero = "https://github.com/openhie/openinfoman-mhero";

declare namespace csd  =  "urn:ihe:iti:csd:2013";

declare variable $careServicesRequest as item() external;

let $mhero_doc := /.
let $mhero := $careServicesRequest/@resource
let $mhero := $careServicesRequest/documents/mhero/@resource

for $doc  in $careServicesRequest/documents/document
let $name := $doc/@resource
let $src_doc :=
  if (not ($name  = ''))
  then if (not ($name = $mhero)) then csd_dm:open_document($csd_webconf:db, $name) else ()
  else $doc
return mhero:merge_into($mhero_doc, $src_doc)


MarkLogic: Keep the query handlers self-contained.

(:
 : Copyright (C) 2018-2019 Reece H. Dunn
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at
 :
 : http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, software
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
 :)
xquery version "1.0-ml";
declare namespace o = "http://reecedunn.co.uk/xquery/options";
declare option o:implementation "marklogic/6.0";

(:~ Run a query on a MarkLogic server.
 :
 : @param $mode Whether to "run", "profile", or "debug" the query.
 : @param $mimetype The mimetype of the query.
 : @param $module-path The path of the module to invoke, or "" for evaluated scripts.
 : @param $query The query script to evaluate, or "" for invoked modules.
 : @param $vars A map of the variable values by the variable name.
 : @param $types A map of the variable types by the variable name.
 :
 : This script has additional logic to map the semantics of the REST/XCC API to
 : the semantics of the API implemented in the xquery-intellij-plugin to support
 : the Run/Debug Configurations of the IntelliJ IDEs. Specifically:
 :
 : 1.  If there is an error, the REST API returns a "500 Internal Error" HTTP
 :     status. This catches the error and returns an element(err:error) object.
 :
 : 2.  The variables are passed via the REST API as xs:untypedAtomic. This
 :     converts the variables to the type they were specified as in the
 :     xquery-intellij-plugin API.
 :
 : 3.  The REST API only returns the primitive type of each item.
 :)

declare variable $mode as xs:string external;
declare variable $mimetype as xs:string external;
declare variable $module-path as xs:string external;
declare variable $query as xs:string external;
declare variable $vars as xs:string external;
declare variable $types as xs:string external;

declare function local:cast-as($value, $type) {
    switch ($type)
    case "xs:anyURI" return $value cast as xs:anyURI
    case "xs:base64Binary" return $value cast as xs:base64Binary
    case "xs:boolean" return $value cast as xs:boolean
    case "xs:byte" return $value cast as xs:byte
    case "xs:date" return $value cast as xs:date
    case "xs:dateTime" return $value cast as xs:dateTime
    case "xs:dateTimeStamp" return $value cast as xs:dateTime (: MarkLogic does not support XML Schema 1.1 Part 2 :)
    case "xs:dayTimeDuration" return $value cast as xs:dayTimeDuration
    case "xs:decimal" return $value cast as xs:decimal
    case "xs:double" return $value cast as xs:double
    case "xs:duration" return $value cast as xs:duration
    case "xs:float" return $value cast as xs:float
    case "xs:gDay" return $value cast as xs:gDay
    case "xs:gMonth" return $value cast as xs:gMonth
    case "xs:gMonthDay" return $value cast as xs:gMonthDay
    case "xs:gYear" return $value cast as xs:gYear
    case "xs:gYearMonth" return $value cast as xs:gYearMonth
    case "xs:hexBinary" return $value cast as xs:hexBinary
    case "xs:int" return $value cast as xs:int
    case "xs:integer" return $value cast as xs:integer
    case "xs:language" return $value cast as xs:language
    case "xs:long" return $value cast as xs:long
    case "xs:negativeInteger" return $value cast as xs:negativeInteger
    case "xs:nonNegativeInteger" return $value cast as xs:nonNegativeInteger
    case "xs:nonPositiveInteger" return $value cast as xs:nonPositiveInteger
    case "xs:normalizedString" return $value cast as xs:normalizedString
    case "xs:numeric" return $value cast as xs:numeric
    case "xs:positiveInteger" return $value cast as xs:positiveInteger
    case "xs:short" return $value cast as xs:short
    case "xs:string" return $value cast as xs:string
    case "xs:time" return $value cast as xs:time
    case "xs:token" return $value cast as xs:token
    case "xs:unsignedByte" return $value cast as xs:unsignedByte
    case "xs:unsignedInt" return $value cast as xs:unsignedInt
    case "xs:unsignedLong" return $value cast as xs:unsignedLong
    case "xs:unsignedShort" return $value cast as xs:unsignedShort
    case "xs:yearMonthDuration" return $value cast as xs:yearMonthDuration
    case "xs:ENTITY" return $value cast as xs:ENTITY
    case "xs:ID" return $value cast as xs:ID
    case "xs:IDREF" return $value cast as xs:IDREF
    case "xs:Name" return $value cast as xs:Name
    case "xs:NCName" return $value cast as xs:NCName
    case "xs:NMTOKEN" return $value cast as xs:NMTOKEN
    case "xs:QName" return $value cast as xs:QName
    default return $value
};

declare function local:parse-vars($values as map:map, $types as map:map) as item()* {
    for $key in map:keys($values)
    let $value := local:cast-as(map:get($values, $key), map:get($types, $key))
    return (xs:QName($key), $value)
};

declare function local:derived-type-name($value) {
    (: NOTE: Ordering is important here -- reverse type hierarchy :)
    typeswitch ($value)
    case function(*) return "function(*)"
    (: xs:integer derived types :)
    case xs:positiveInteger return "xs:positiveInteger"
    case xs:unsignedByte return "xs:unsignedByte"
    case xs:unsignedShort return "xs:unsignedShort"
    case xs:unsignedInt return "xs:unsignedInt"
    case xs:unsignedLong return "xs:unsignedLong"
    case xs:nonNegativeInteger return "xs:nonNegativeInteger"
    case xs:byte return "xs:byte"
    case xs:short return "xs:short"
    case xs:int return "xs:int"
    case xs:long return "xs:long"
    case xs:negativeInteger return "xs:negativeInteger"
    case xs:nonPositiveInteger return "xs:nonPositiveInteger"
    (: xs:string derived types :)
    case xs:ENTITY return "xs:ENTITY"
    case xs:IDREF return "xs:IDREF"
    case xs:ID return "xs:ID"
    case xs:NCName return "xs:NCName"
    case xs:Name return "xs:Name"
    case xs:NMTOKEN return "xs:NMTOKEN"
    case xs:language return "xs:language"
    case xs:token return "xs:token"
    case xs:normalizedString return "xs:normalizedString"
    default return () (: primitive type, so does not need the type name to be specified. :)
};

declare function local:error(
    $err:code as xs:QName,
    $err:description as xs:string?,
    $err:value as item()*,
    $err:module as xs:string?,
    $err:line-number as xs:integer?,
    $err:column-number as xs:integer,
    $err:additional as element(error:error)
) {
    <err:error xmlns:dbg="http://reecedunn.co.uk/xquery/debug">
        <err:code>{$err:code}</err:code>
        <err:vendor-code>{$err:additional/error:code/text()}</err:vendor-code>
        <err:description>{$err:additional/error:message/text()}</err:description>
        <err:value count="{count($err:value)}"></err:value>
        <err:module line="{$err:line-number}" column="{$err:column-number + 1}">{$err:module}</err:module>
        <dbg:stack>{
            for $frame in $err:additional/error:stack/error:frame[position() != last()]
            let $module := $frame/error:uri/text()
            let $line := $frame/error:line/text() cast as xs:integer?
            let $column := $frame/error:column/text() cast as xs:integer?
            return <dbg:frame><dbg:module line="{$line}" column="{$column + 1}">{$module}</dbg:module></dbg:frame>
        }</dbg:stack>
    </err:error>
};

declare function local:version() {
    substring-before(xdmp:version(), "-") cast as xs:double
};

declare function local:function($ref as xs:string) {
    try { xdmp:eval($ref) } catch * { () }
};

declare function local:javascript() as item()* {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $options := ()
    return if (local:version() < 8.0) then
        fn:error(
            xs:QName("UNSUPPORTED-VERSION"),
            "MarkLogic " || xdmp:version() || " does not support server-side JavaScript"
        )
    else if (string-length($query) ne 0) then
        switch ($mode)
        case "run" return
            let $f := local:function("xdmp:javascript-eval#3")
            return $f($query, $variables, $options)
        default return ()
    else
        switch ($mode)
        case "run" return xdmp:invoke($module-path, $variables, $options)
        default return ()
};

declare function local:sql() as item()* {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $query :=
        if (string-length($query) ne 0) then
            $query
        else
            () (: TODO: Read the contents of the query file from the modules database. :)
    return switch ($mode)
    case "run" return
        if (local:version() < 9.0) then
            let $f := local:function("xdmp:sql#1")
            return $f($query)
        else
            let $f := local:function("xdmp:sql#3")
            return $f($query, (), $variables)
    default return ()
};

declare function local:xquery() as item()* {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $options := ()
    return if (string-length($query) ne 0) then
        switch ($mode)
        case "run" return xdmp:eval($query, $variables, $options)
        case "profile" return prof:eval($query, $variables, $options)
        default return ()
    else
        switch ($mode)
        case "run" return xdmp:invoke($module-path, $variables, $options)
        case "profile" return prof:invoke($module-path, $variables, $options)
        default return ()
};

try {
    let $retvals :=
        switch ($mimetype)
        case "application/javascript" return local:javascript()
        case "application/sql" return local:sql()
        case "application/xquery" return local:xquery()
        default return ()

    for $retval at $i in $retvals
    let $_ := local:derived-type-name($retval) ! xdmp:add-response-header("X-Derived-" || $i, .)
    return $retval
} catch * {
    let $_ := xdmp:add-response-header("X-Derived-1", "err:error")
    return local:error($err:code, $err:description, $err:value, $err:module, $err:line-number, $err:column-number, $err:additional)
}

(:
 : Copyright (C) 2018-2019 Reece H. Dunn
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at
 :
 : http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, software
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
 :)
xquery version "1.0-ml";
declare namespace o = "http://reecedunn.co.uk/xquery/options";
declare option o:implementation "marklogic/6.0";

(:~ Run a query on a MarkLogic server.
 :
 : @param $mode Whether to "run", "profile", or "debug" the query.
 : @param $mimetype The mimetype of the query.
 : @param $module-path The path of the module to invoke, or "" for evaluated scripts.
 : @param $query The query script to evaluate, or "" for invoked modules.
 : @param $vars A map of the variable values by the variable name.
 : @param $types A map of the variable types by the variable name.
 :
 : This script has additional logic to map the semantics of the REST/XCC API to
 : the semantics of the API implemented in the xquery-intellij-plugin to support
 : the Run/Debug Configurations of the IntelliJ IDEs. Specifically:
 :
 : 1.  If there is an error, the REST API returns a "500 Internal Error" HTTP
 :     status. This catches the error and returns an element(err:error) object.
 :
 : 2.  The variables are passed via the REST API as xs:untypedAtomic. This
 :     converts the variables to the type they were specified as in the
 :     xquery-intellij-plugin API.
 :
 : 3.  The REST API only returns the primitive type of each item.
 :)

declare variable $mode as xs:string external;
declare variable $mimetype as xs:string external;
declare variable $module-path as xs:string external;
declare variable $query as xs:string external;
declare variable $vars as xs:string external;
declare variable $types as xs:string external;

declare function local:cast-as($value, $type) {
    switch ($type)
    case "xs:anyURI" return $value cast as xs:anyURI
    case "xs:base64Binary" return $value cast as xs:base64Binary
    case "xs:boolean" return $value cast as xs:boolean
    case "xs:byte" return $value cast as xs:byte
    case "xs:date" return $value cast as xs:date
    case "xs:dateTime" return $value cast as xs:dateTime
    case "xs:dateTimeStamp" return $value cast as xs:dateTime (: MarkLogic does not support XML Schema 1.1 Part 2 :)
    case "xs:dayTimeDuration" return $value cast as xs:dayTimeDuration
    case "xs:decimal" return $value cast as xs:decimal
    case "xs:double" return $value cast as xs:double
    case "xs:duration" return $value cast as xs:duration
    case "xs:float" return $value cast as xs:float
    case "xs:gDay" return $value cast as xs:gDay
    case "xs:gMonth" return $value cast as xs:gMonth
    case "xs:gMonthDay" return $value cast as xs:gMonthDay
    case "xs:gYear" return $value cast as xs:gYear
    case "xs:gYearMonth" return $value cast as xs:gYearMonth
    case "xs:hexBinary" return $value cast as xs:hexBinary
    case "xs:int" return $value cast as xs:int
    case "xs:integer" return $value cast as xs:integer
    case "xs:language" return $value cast as xs:language
    case "xs:long" return $value cast as xs:long
    case "xs:negativeInteger" return $value cast as xs:negativeInteger
    case "xs:nonNegativeInteger" return $value cast as xs:nonNegativeInteger
    case "xs:nonPositiveInteger" return $value cast as xs:nonPositiveInteger
    case "xs:normalizedString" return $value cast as xs:normalizedString
    case "xs:numeric" return $value cast as xs:numeric
    case "xs:positiveInteger" return $value cast as xs:positiveInteger
    case "xs:short" return $value cast as xs:short
    case "xs:string" return $value cast as xs:string
    case "xs:time" return $value cast as xs:time
    case "xs:token" return $value cast as xs:token
    case "xs:unsignedByte" return $value cast as xs:unsignedByte
    case "xs:unsignedInt" return $value cast as xs:unsignedInt
    case "xs:unsignedLong" return $value cast as xs:unsignedLong
    case "xs:unsignedShort" return $value cast as xs:unsignedShort
    case "xs:yearMonthDuration" return $value cast as xs:yearMonthDuration
    case "xs:ENTITY" return $value cast as xs:ENTITY
    case "xs:ID" return $value cast as xs:ID
    case "xs:IDREF" return $value cast as xs:IDREF
    case "xs:Name" return $value cast as xs:Name
    case "xs:NCName" return $value cast as xs:NCName
    case "xs:NMTOKEN" return $value cast as xs:NMTOKEN
    case "xs:QName" return $value cast as xs:QName
    default return $value
};

declare function local:parse-vars($values as map:map, $types as map:map) as item()* {
    for $key in map:keys($values)
    let $value := local:cast-as(map:get($values, $key), map:get($types, $key))
    return (xs:QName($key), $value)
};

declare function local:derived-type-name($value) {
    (: NOTE: Ordering is important here -- reverse type hierarchy :)
    typeswitch ($value)
    case function(*) return "function(*)"
    (: xs:integer derived types :)
    case xs:positiveInteger return "xs:positiveInteger"
    case xs:unsignedByte return "xs:unsignedByte"
    case xs:unsignedShort return "xs:unsignedShort"
    case xs:unsignedInt return "xs:unsignedInt"
    case xs:unsignedLong return "xs:unsignedLong"
    case xs:nonNegativeInteger return "xs:nonNegativeInteger"
    case xs:byte return "xs:byte"
    case xs:short return "xs:short"
    case xs:int return "xs:int"
    case xs:long return "xs:long"
    case xs:negativeInteger return "xs:negativeInteger"
    case xs:nonPositiveInteger return "xs:nonPositiveInteger"
    (: xs:string derived types :)
    case xs:ENTITY return "xs:ENTITY"
    case xs:IDREF return "xs:IDREF"
    case xs:ID return "xs:ID"
    case xs:NCName return "xs:NCName"
    case xs:Name return "xs:Name"
    case xs:NMTOKEN return "xs:NMTOKEN"
    case xs:language return "xs:language"
    case xs:token return "xs:token"
    case xs:normalizedString return "xs:normalizedString"
    default return () (: primitive type, so does not need the type name to be specified. :)
};

declare function local:error(
    $err:code as xs:QName,
    $err:description as xs:string?,
    $err:value as item()*,
    $err:module as xs:string?,
    $err:line-number as xs:integer?,
    $err:column-number as xs:integer,
    $err:additional as element(error:error)
) {
    <err:error xmlns:dbg="http://reecedunn.co.uk/xquery/debug">
        <err:code>{$err:code}</err:code>
        <err:vendor-code>{$err:additional/error:code/text()}</err:vendor-code>
        <err:description>{$err:additional/error:message/text()}</err:description>
        <err:value count="{count($err:value)}"></err:value>
        <err:module line="{$err:line-number}" column="{$err:column-number + 1}">{$err:module}</err:module>
        <dbg:stack>{
            for $frame in $err:additional/error:stack/error:frame[position() != last()]
            let $module := $frame/error:uri/text()
            let $line := $frame/error:line/text() cast as xs:integer?
            let $column := $frame/error:column/text() cast as xs:integer?
            return <dbg:frame><dbg:module line="{$line}" column="{$column + 1}">{$module}</dbg:module></dbg:frame>
        }</dbg:stack>
    </err:error>
};

declare function local:version() {
    substring-before(xdmp:version(), "-") cast as xs:double
};

declare function local:function($ref as xs:string) {
    try { xdmp:eval($ref) } catch * { () }
};

declare function local:javascript($variables, $options, $mode) as item()* {
    if (local:version() < 8.0) then
        fn:error(
            xs:QName("UNSUPPORTED-VERSION"),
            "MarkLogic " || xdmp:version() || " does not support server-side JavaScript"
        )
    else if (string-length($query) ne 0) then
        switch ($mode)
        case "run" return
            let $f := local:function("xdmp:javascript-eval#3")
            return $f($query, $variables, $options)
        default return ()
    else
        switch ($mode)
        case "run" return xdmp:invoke($module-path, $variables, $options)
        default return ()
};

declare function local:sql($variables, $options, $mode) as item()* {
    let $query :=
        if (string-length($query) ne 0) then
            $query
        else
            () (: TODO: Read the contents of the query file from the modules database. :)
    return switch ($mode)
    case "run" return
        if (local:version() < 9.0) then
            let $f := local:function("xdmp:sql#1")
            return $f($query)
        else
            let $f := local:function("xdmp:sql#3")
            return $f($query, (), $variables)
    default return ()
};

declare function local:xquery($variables, $options, $mode) as item()* {
    if (string-length($query) ne 0) then
        switch ($mode)
        case "run" return xdmp:eval($query, $variables, $options)
        case "profile" return prof:eval($query, $variables, $options)
        default return ()
    else
        switch ($mode)
        case "run" return xdmp:invoke($module-path, $variables, $options)
        case "profile" return prof:invoke($module-path, $variables, $options)
        default return ()
};

try {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $options := ()

    let $retvals :=
        switch ($mimetype)
        case "application/javascript" return local:javascript($variables, $options, $mode)
        case "application/sql" return local:sql($variables, $options, $mode)
        case "application/xquery" return local:xquery($variables, $options, $mode)
        default return ()

    for $retval at $i in $retvals
    let $_ := local:derived-type-name($retval) ! xdmp:add-response-header("X-Derived-" || $i, .)
    return $retval
} catch * {
    let $_ := xdmp:add-response-header("X-Derived-1", "err:error")
    return local:error($err:code, $err:description, $err:value, $err:module, $err:line-number, $err:column-number, $err:additional)
}


Further fixes in xqts.xql to make it more accurate, just some issues left.

svn path=/trunk/eXist/; revision=6380

xquery version "1.0";

declare namespace xqts="http://exist-db.org/xquery/xqts";
declare namespace catalog="http://www.w3.org/2005/02/query-test-XQTSCatalog";

declare namespace props="java:java.io.File";

import module namespace util="http://exist-db.org/xquery/util";
import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace xdiff="http://exist-db.org/xquery/xmldiff"
at "java:org.exist.xquery.modules.xmldiff.XmlDiffModule";
import module namespace request="http://exist-db.org/xquery/request";
declare namespace system="http://exist-db.org/xquery/system";

(: $Id$ :)

(:~  ----------------------------------------------------------------------------
     W3C XQuery Test Suite

     This is the main module for running the XQTS on eXist. You can either
     run the whole test suite, a specific test group or a single test case.

     Setup:

     * Make sure the XmlDiff module is registered in conf.xml

     * Edit config.xml and change basedir to point to the directory into
     which you unzipped the XQTS sources. Note: it needs to be an URI.

     * Create a collection /db/XQTS in the database.

     * From the XQTS directory, upload XQTSCatalog.xml into the created
     collection.

     * Upload the "TestSources" directory so the source docs can be found
     in /db/XQTS/TestSources.

     * Run this script with the client.
     -------------------------------------------------------------------------- :)
declare variable $xqts:CONFIG := xqts:initialize();
declare variable $xqts:XQTS_HOME := xqts:path-to-uri($xqts:CONFIG/basedir/text());

declare function xqts:initialize() as element() {
    let $home := system:get-exist-home()
    let $path := concat($home, "/webapp/xqts")
    let $collection := xdb:create-collection("/db", "XQTS")
    let $config0 := doc("/db/XQTS")/config
    let $config :=
        if ($config0) then
            $config0
        else
            let $stored := xdb:store-files-from-pattern("/db/XQTS", $path, "*.xml", "text/xml")
            return
                doc("/db/XQTS/config.xml")/config
    let $xqtsHome := $config/basedir/text()
    let $catalog0 := doc("/db/XQTS/XQTSCatalog.xml")
    let $catalog :=
        if ($catalog0) then $catalog0
        else
            xdb:store($collection, "XQTSCatalog.xml",
                xs:anyURI(xqts:path-to-uri(concat($xqtsHome, "XQTSCatalog.xml"))))
    let $sources0 := collection("/db/XQTS/TestSources")
    let $sources :=
        if ($sources0) then
            $sources0
        else
            let $sourceCol := xdb:create-collection("/db/XQTS", "TestSources")
            return
                xdb:store-files-from-pattern($sourceCol, concat($xqtsHome, "TestSources"), "*.xml", "text/xml")
    return
        $config
};

declare function xqts:path-to-uri($path as xs:string) as xs:string {
        if (starts-with($path, "/")) then
            concat("file://", $path)
        else
            concat("file:///", $path)
};

declare function xqts:create-progress-file($testCount as xs:int) as empty() {
    let $results := xdb:store("/db/XQTS", "progress.xml",
        <progress total="{$testCount}" done="0" failed="0" passed="0" error="0"/>)
    return ()
};

declare function xqts:report-progress($test-case as element()) as empty() {
    let $result := string($test-case/@result)
    let $progress := doc("/db/XQTS/progress.xml")/progress
    let $counter := $progress/@done
    return (
        update value $counter with xs:int($counter + 1),
        if ($result eq 'fail') then
            update value $progress/@failed with xs:int($progress/@failed + 1)
        else if ($result eq 'error') then
            update value $progress/@error with xs:int($progress/@error + 1)
        else
            update value $progress/@passed with xs:int($progress/@passed + 1)
    )
};

declare function xqts:create-collections($group as element(catalog:test-group)) as node() {
    let $rootColl := xdb:create-collection("/db/XQTS", "test-results")
    let $ancestors := reverse(($group/ancestor::catalog:test-group, $group))
    let $collection := xqts:create-collections($rootColl, $ancestors, "/db/XQTS/test-results")
    let $results := xdb:store($collection, "results.xml", <test-result failed="0" passed="0" error="0"/>)
    return
        doc($results)
};

declare function xqts:create-collections($parent as object,
    $pathElements as element()+, $currentPath as xs:string)
as object {
    let $next := $pathElements[last()]
    let $remainder := subsequence($pathElements, 1, count($pathElements) - 1)
    let $newColl := xdb:create-collection($parent, $next/@name)
    return
        if ($remainder) then
            xqts:create-collections($newColl, $remainder, concat($currentPath, "/", $next/@name))
        else
            $newColl
};

declare function xqts:get-query($case as element(catalog:test-case)) {
   let $query-name := $case//catalog:query/@name
   let $path := concat( $xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $query-name, ".xq" )
   let $xq-string := util:file-read($path, "UTF-8")
   return $xq-string
};

declare function xqts:print-result($test-name as xs:string, $passed as xs:boolean, $query as xs:string,
    $result as item()*, $expected as item()*, $case as element(catalog:test-case)) as element() {
    <test-case name="{$test-name}" result="{if ($passed) then 'pass' else 'fail'}" dateRun="{util:system-time()}" print="print-result">
    {
        if (not($passed)) then (
            <result>{$result}</result>,
            if ($expected instance of element() and count($expected/*) > 10) then
            	<expected truncated="">{$expected/*[position() < 10]}</expected>
            else
                <expected>{$expected}</expected>,
            (: element {$case/catalog:input-file/@variable} { xqts:getInputValue($case) }, :)
            <query>{$query}</query>
        ) else ()
    }
    </test-case>
};

declare function xqts:normalize-text($result as item()*) as xs:string {
    let $str := string-join(for $i in $result return string($i), " ")
    return
        (: Remove leading and trailing whitespace :)
        replace(replace($str, "^\s+", ""), "\s+$", "")
};

declare function xqts:normalize-and-expand($text as item()*) as xs:string {
	replace(replace(replace(xqts:normalize-text($text), "&amp;", "&", "m"), "&lt;", "<"),
		"&gt;", ">")
};

declare function xqts:check-output($query as xs:string, $result as item()*, $case as element(catalog:test-case)) {
  let $all-results :=
    for $output in $case/catalog:output-file
    return
        (: Expected only an error, but still got a result :)
        if (fn:exists($case/catalog:expected-error) and fn:empty($case/catalog:output-file)) then
            <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}" print="expected-error-and-no-output">
                   <expected-error>{string-join($case/catalog:expected-error/text(), ";")}</expected-error>
                   <result>{$result}</result>
                   <query>{$query}</query>
            </test-case>
        (: Comparison method: "Text" :)
        else if ($output/@compare eq "Text") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()), "UTF-8")
            let $test := xqts:normalize-and-expand($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)
        (: Comparison method: "XML" :)
        else if ($output/@compare eq "XML") then
            util:catch("java.lang.Exception",
                let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                    $output/text())
                let $expected := doc(xdb:store("/db", "temp.xml", xs:anyURI($filePath), "text/xml"))
                let $test := xdiff:compare($expected, $result)
                return
                    xqts:print-result($case/@name, $test, $query, $result, $expected, $case),
                (: Handle unexpected exceptions :)
                <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}" print="xml-compare-unexpected-exception">
                   <exception>Exception while loading expected result: {$util:exception-message}</exception>
                   <query>{$query}</query>
                </test-case>
            )
        (: Comparison method: "Fragment" :)
        else if ($output/@compare eq "Fragment") then
            util:catch("java.lang.Exception",
                let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath, $output/text())
                let $expectedFrag := util:file-read($filePath, "UTF-8")
                let $xmlFrag := concat("<f>", $expectedFrag, "</f>")
                let $expected := doc(xdb:store("/db", "temp.xml", $xmlFrag, "text/xml"))
                (:
                let $log := util:log("DEBUG", ("Frag stored: ", $xmlFrag))
                let $doh := doc(xdb:store("/db", $output, $xmlFrag, "text/xml"))
		:)
                let $test := xdiff:compare($expected, <f>{$result}</f>)
                return
                    xqts:print-result($case/@name, $test, $query, <f>{$result}</f>, $expected, $case),
                (: Handle unexpected exceptions :)
                <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}" print="fragment-compare-unexpected-exception">
                   <exception>Exception while loading expected result fragment: {$util:exception-message}</exception>
                   <query>{$query}</query>
                </test-case>
            )
        (: Comparison method: "Inspect" :)
        (: A text compare is sufficient in many test cases :)
        else if ($output/@compare eq "Inspect") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()), "UTF-8")
            let $test := xqts:normalize-text($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)

        (: Don't know how to compare :)
      else
        <test-case name="{$case/@name}" result="error" dateRun="{util:system-time()}" print="unknown-comparison-method">
          <error test="{$case/@name}">Unknown comparison method: {$output/@compare}.</error>
          <query>{$query}</query>
	</test-case>
    (: Use this let clause to get an update insert failure from the 5314th
       test and onward in xqts:report-progress(). in-memory-temp-frag corrpution
       reproducible in xqts, who could imagine... /ljo :)
    (: let $passed := $all-results//test-case[@result eq 'pass'] :)
    let $passed :=
      if (fn:exists($all-results[2])) then
	let $result-frag := concat("<f>", fn:string-join($all-results, ""), "</f>")
	let $results-doc := doc(xdb:store("/db", "temp-res.xml", $result-frag, "text/xml"))
        return $results-doc//test-case[@result eq 'pass']
      else ()
    return
      if (fn:exists($passed)) then
	$passed[1]
      else if (fn:exists($all-results[1])) then
	$all-results[1]
      else
        (: Expected runtime-exception, but got a result :)
      if (fn:exists($case//catalog:expected-error) and fn:empty($case//catalog:output-file) and $case/@scenario eq "runtime-error") then
        <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}" print="expected-error-and-no-output">
          <expected-error>{string-join($case/catalog:expected-error/text(), ";")}</expected-error>
          <result>{$result}</result>
          <query>{$query}</query>
        </test-case>
      else
	let $log-all := util:log("DEBUG", ("Unhandled error, no result for: ", xs:string($case/@name)))
	return
	  <test-case name="{$case/@name}" result="error" dateRun="{util:system-time()}" print="unhandled-error">
    	    <error test="{$case/@name}">Cannot handle: {$case/@name}.</error>
            <query>{$query}</query>
          </test-case>

};

declare function xqts:get-variable($case as element(catalog:test-case),
	$name as xs:string) as item()* {
	let $path := concat( $xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $name, ".xq" )
	let $xq-string := util:file-read($path, "UTF-8")
	return
		if (empty($xq-string)) then
			()
		else
			util:eval($xq-string)
};

declare function xqts:run-test-case( $testCase as element(catalog:test-case)) as item()* {
   let $query := xqts:get-query($testCase)
   let $result :=
       util:catch("java.lang.Exception",
			let $context :=
				<static-context>
       			{
           			for $input in $testCase/catalog:input-file
           			return
               			<variable name="{$input/@variable}">{xqts:get-input-value($input)}</variable>,
            		for $var in $testCase/catalog:input-query
            		return
                		<variable name="{$var/@variable}">
                    		{xqts:get-variable($testCase, $var/@name)}
                		</variable>
       			}
       			</static-context>
           let $result :=
               util:eval-with-context($query, $context, false(), xqts:get-context-item($testCase/catalog:contextItem))
           return
               xqts:check-output($query, $result, $testCase),
	     (: Only expected exception and got exception.
	        No check on if it is the right exception, though. :)
           if (fn:exists($testCase//catalog:expected-error) and fn:empty($testCase//catalog:output-file)) then
               <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}" print="expected-exception-got-exception">
                   <exception>{$util:exception-message}</exception>
                   <expected-error>{string-join($testCase//catalog:expected-error/text(),";")}</expected-error>
                   <query>{$query}</query>
               </test-case>
           else
	     (: Expected either output or exception. :)
	     if (fn:exists($testCase//catalog:expected-error) and fn:exists($testCase//catalog:output-file)) then
               <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}" print="exception-or-output">
                   <exception>{$util:exception-message}</exception>
                   <expected-error>{string-join($testCase//catalog:expected-error/text(),";")}</expected-error>
		   {
		     for $output in $testCase//catalog:output-file
		     return <expected>{
                     let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $testCase/@FilePath, $output/text())
                     return util:file-read($filePath, "UTF-8")
                     }</expected>
		   }
                   <query>{$query}</query>
               </test-case>
           else if (fn:empty($testCase//catalog:expected-error) and fn:exists($testCase//catalog:output-file)) then
 	     (: Expected output, but got exception. :)
               <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}" print="expected-output-got-exception">
                   <exception>{$util:exception-message}</exception>
		   {
		     for $output in $testCase//catalog:output-file
		     return <expected>{
                     let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $testCase/@FilePath, $output/text())
                     return util:file-read($filePath, "UTF-8")
                     }</expected>
		   }
                   <query>{$query}</query>
               </test-case>
	     else
 	     (: Don't know what is expected but got here anyway. :)
               <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}" print="unhandled-result">
                   <exception>{$util:exception-message}</exception>
                   <expected-error>{string-join($testCase//catalog:expected-error/text(),";")}</expected-error>
		   {
		     if (fn:exists($testCase//catalog:output-file)) then
		     for $output in $testCase//catalog:output-file
		     return <expected>{
                     let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $testCase/@FilePath, $output/text())
                     return util:file-read($filePath, "UTF-8")
                     }</expected>
		     else ()
		   }
                   <query>{$query}</query>
               </test-case>
       )
       let $log := if (fn:empty($result)) then util:log("DEBUG", ("FAILURE in-memory-frag in test: ", xs:string($testCase/@name))) else ()
   return $result
};

declare function xqts:finish($result as element()) as empty() {
    let $passed := count($result//test-case[@result = 'pass'])
    let $failed := count($result//test-case[@result = 'fail'])
    let $error := count($result//test-case[@result = 'error'])
    return (
        update value $result/@passed with xs:int($passed),
        update value $result/@failed with xs:int($failed),
        update value $result/@error with xs:int($error)
    )
};

declare function xqts:run-single-test-case($case as element(catalog:test-case),
    $resultRoot as element()?) as empty() {
    let $result := xqts:run-test-case($case)
    return (
        update insert $result into $resultRoot,
        let $added := $resultRoot/test-case[@name = $case/@name]
       let $log := if (fn:empty($added)) then util:log("DEBUG", ("FAILURE in-memory-frag in test: ", xs:string($case/@name))) else ()
        return
            if ($added) then xqts:report-progress($added)
            else ()
    )
};

declare function xqts:run-test-group($group as element(catalog:test-group)) as empty() {
    (: Create the collection hierarchy for this group and get the results.xml doc to
        append to. :)
    let $resultsDoc := xqts:create-collections($group)
    let $log-resdoc := util:log("DEBUG", ("Creating resdoc collection: ", $resultsDoc))
    let $tests := $group/catalog:test-case
(:
[
    	not(starts-with(@name, 'Constr-inscope-10')) and
    	not(starts-with(@name, 'Constr-inscope-12')) and
    	not(starts-with(@name, 'Constr-namespace-22'))
]
:)
    return (
        (: Execute the test cases :)
        for $test in $tests
        let $log := util:log("DEBUG", ("Running test case: ", string($test/@name)))
        return
            xqts:run-single-test-case($test, $resultsDoc/test-result),
        if (fn:exists($tests) and fn:exists($resultsDoc/test-result)) then
            xqts:finish($resultsDoc/test-result)
        else
            xdb:remove(util:collection-name($resultsDoc), util:document-name($resultsDoc)),
        (: Execute tests in child groups :)
        for $childGroup in $group/catalog:test-group
        let $log := util:log("DEBUG", ("Entering group: ", string($childGroup/@name)))
        return
            xqts:run-test-group($childGroup)
    )
};

declare function xqts:test-single($name as xs:string) as element() {
    let $test := //catalog:test-case[@name = $name]
    return
        if ($test) then
            let $resultsDoc := xqts:create-collections($test/parent::catalog:test-group)
            let $dummy := xqts:run-single-test-case($test, $resultsDoc/test-result)
            return
                $resultsDoc/test-result
        else
            <error>Test case not found: {$name}.</error>
};

declare function xqts:test-group($groupName as xs:string) as empty() {
    let $group := //catalog:test-group[@name = $groupName]
    return (
        xqts:create-progress-file(count($group//catalog:test-case)),
        xqts:run-test-group($group)
    )
};

declare function xqts:test-all() as empty() {
    for $test in /catalog:test-suite/catalog:test-group
    return
        xqts:test-group($test/@name)
};

declare function xqts:get-input-value($input as element(catalog:input-file)) as item()* {
   if ($input eq "emptydoc") then
       ()
   else (
       let $source := root($input)//catalog:source[@ID = $input/text()]
       return
           if (empty($source)) then
               concat("no input found: ", $input/text())
           else
               doc(concat("/db/XQTS/", $source/@FileName))
   )
};

declare function xqts:get-context-item($input as element(catalog:contextItem)?) as item()* {
	if (empty($input)) then
       ()
	else (
	   let $source := root($input)//catalog:source[@ID = $input/text()]
		return
   	   	if (empty($source)) then
			concat("no input found: ", $input/text())
       	else
			doc(concat("/db/XQTS/", $source/@FileName))
	)
};

declare function xqts:overall-result() {
    let $passed := count(//test-case[@result = "pass"])
    let $failed := count(//test-case[@result = "fail"])
    let $error := count(//test-case[@result = "error"])
    return
        <test-result failed="{$failed}" passed="{$passed}"
	    error="{$error}"
            percentage="{$passed div ($passed + $failed)}"/>
};

let $group := request:get-parameter('group', ())
return
    if ($group) then
        xqts:test-group($group)
    else
        ()

xquery version "1.0";

declare namespace xqts="http://exist-db.org/xquery/xqts";
declare namespace catalog="http://www.w3.org/2005/02/query-test-XQTSCatalog";

declare namespace props="java:java.io.File";

import module namespace util="http://exist-db.org/xquery/util";
import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace xdiff="http://exist-db.org/xquery/xmldiff"
at "java:org.exist.xquery.modules.xmldiff.XmlDiffModule";
import module namespace request="http://exist-db.org/xquery/request";
declare namespace system="http://exist-db.org/xquery/system";

(: $Id$ :)

(:~  ----------------------------------------------------------------------------
     W3C XQuery Test Suite

     This is the main module for running the XQTS on eXist. You can either
     run the whole test suite, a specific test group or a single test case.

     Setup:

     * Make sure the XmlDiff module is registered in conf.xml

     * Edit config.xml and change basedir to point to the directory into
     which you unzipped the XQTS sources. Note: it needs to be an URI.

     * Create a collection /db/XQTS in the database.

     * From the XQTS directory, upload XQTSCatalog.xml into the created
     collection.

     * Upload the "TestSources" directory so the source docs can be found
     in /db/XQTS/TestSources.

     * Run this script with the client.
     -------------------------------------------------------------------------- :)
declare variable $xqts:CONFIG := xqts:initialize();
declare variable $xqts:XQTS_HOME := xqts:path-to-uri($xqts:CONFIG/basedir/text());

declare function xqts:initialize() as element() {
    let $home := system:get-exist-home()
    let $path := concat($home, "/webapp/xqts")
    let $collection := xdb:create-collection("/db", "XQTS")
    let $config0 := doc("/db/XQTS")/config
    let $config :=
        if ($config0) then
            $config0
        else
            let $stored := xdb:store-files-from-pattern("/db/XQTS", $path, "*.xml", "text/xml")
            return
                doc("/db/XQTS/config.xml")/config
    let $xqtsHome := $config/basedir/text()
    let $catalog0 := doc("/db/XQTS/XQTSCatalog.xml")
    let $catalog :=
        if ($catalog0) then $catalog0
        else
            xdb:store($collection, "XQTSCatalog.xml",
                xs:anyURI(xqts:path-to-uri(concat($xqtsHome, "XQTSCatalog.xml"))))
    let $sources0 := collection("/db/XQTS/TestSources")
    let $sources :=
        if ($sources0) then
            $sources0
        else
            let $sourceCol := xdb:create-collection("/db/XQTS", "TestSources")
            return
                xdb:store-files-from-pattern($sourceCol, concat($xqtsHome, "TestSources"), "*.xml", "text/xml")
    return
        $config
};

declare function xqts:path-to-uri($path as xs:string) as xs:string {
        if (starts-with($path, "/")) then
            concat("file://", $path)
        else
            concat("file:///", $path)
};

declare function xqts:create-progress-file($testCount as xs:int) as empty() {
    let $results := xdb:store("/db/XQTS", "progress.xml",
        <progress total="{$testCount}" done="0" failed="0" passed="0" error="0"/>)
    return ()
};

declare function xqts:report-progress($test-case as element()) as empty() {
    let $result := string($test-case/@result)
    let $progress := doc("/db/XQTS/progress.xml")/progress
    let $counter := $progress/@done
    return (
        update value $counter with xs:int($counter + 1),
        if ($result eq 'fail') then
            update value $progress/@failed with xs:int($progress/@failed + 1)
        else if ($result eq 'error') then
            update value $progress/@error with xs:int($progress/@error + 1)
        else
            update value $progress/@passed with xs:int($progress/@passed + 1)
    )
};

declare function xqts:create-collections($group as element(catalog:test-group)) as node() {
    let $rootColl := xdb:create-collection("/db/XQTS", "test-results")
    let $ancestors := reverse(($group/ancestor::catalog:test-group, $group))
    let $collection := xqts:create-collections($rootColl, $ancestors, "/db/XQTS/test-results")
    let $results := xdb:store($collection, "results.xml", <test-result failed="0" passed="0" error="0"/>)
    return
        doc($results)
};

declare function xqts:create-collections($parent as object,
    $pathElements as element()+, $currentPath as xs:string)
as object {
    let $next := $pathElements[last()]
    let $remainder := subsequence($pathElements, 1, count($pathElements) - 1)
    let $newColl := xdb:create-collection($parent, $next/@name)
    return
        if ($remainder) then
            xqts:create-collections($newColl, $remainder, concat($currentPath, "/", $next/@name))
        else
            $newColl
};

declare function xqts:get-query($case as element(catalog:test-case)) {
   let $query-name := $case//catalog:query/@name
   let $path := concat( $xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $query-name, ".xq" )
   let $xq-string := util:file-read($path, "UTF-8")
   return $xq-string
};

declare function xqts:print-result($test-name as xs:string, $passed as xs:boolean, $query as xs:string,
    $result as item()*, $expected as item()*, $case as element(catalog:test-case)) as element() {
    <test-case name="{$test-name}" result="{if ($passed) then 'pass' else 'fail'}" dateRun="{util:system-time()}" print="print-result">
    {
        if (not($passed)) then (
            <result>{$result}</result>,
            if ($expected instance of element() and count($expected/*) > 10) then
            	<expected truncated="">{$expected/*[position() < 10]}</expected>
            else
                <expected>{$expected}</expected>,
            (: element {$case/catalog:input-file/@variable} { xqts:getInputValue($case) }, :)
            <query>{$query}</query>
        ) else ()
    }
    </test-case>
};

declare function xqts:normalize-text($result as item()*) as xs:string {
    let $str := string-join(for $i in $result return string($i), " ")
    return
        (: Remove leading and trailing whitespace :)
        replace(replace($str, "^\s+", ""), "\s+$", "")
};

declare function xqts:normalize-and-expand($text as item()*) as xs:string {
	replace(replace(replace(xqts:normalize-text($text), "&amp;", "&", "m"), "&lt;", "<"),
		"&gt;", ">")
};

declare function xqts:check-output($query as xs:string, $result as item()*, $case as element(catalog:test-case)) {
  let $all-results :=
    for $output in $case/catalog:output-file
    return
        (: Expected only an error, but still got a result :)
        if (fn:exists($case/catalog:expected-error) and fn:empty($case/catalog:output-file)) then
            <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}" print="expected-error-and-no-output">
                   <expected-error>{string-join($case/catalog:expected-error/text(), ";")}</expected-error>
                   <result>{$result}</result>
                   <query>{$query}</query>
            </test-case>
        (: Comparison method: "Text" :)
        else if ($output/@compare eq "Text") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()), "UTF-8")
            let $test := xqts:normalize-and-expand($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)
        (: Comparison method: "XML" :)
        else if ($output/@compare eq "XML") then
            util:catch("java.lang.Exception",
                let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                    $output/text())
                let $expected := doc(xdb:store("/db", "temp.xml", xs:anyURI($filePath), "text/xml"))
                let $test := xdiff:compare($expected, $result)
                return
                    xqts:print-result($case/@name, $test, $query, $result, $expected, $case),
                (: Handle unexpected exceptions :)
                <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}" print="xml-compare-unexpected-exception">
                   <exception>Exception while loading expected result: {$util:exception-message}</exception>
                   <query>{$query}</query>
                </test-case>
            )
        (: Comparison method: "Fragment" :)
        else if ($output/@compare eq "Fragment") then
            util:catch("java.lang.Exception",
                let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath, $output/text())
                let $expectedFrag := util:file-read($filePath, "UTF-8")
                let $xmlFrag := concat("<f>", $expectedFrag, "</f>")
                let $expected := doc(xdb:store("/db", "temp.xml", $xmlFrag, "text/xml"))
                (:
                let $log := util:log("DEBUG", ("Frag stored: ", $xmlFrag))
                let $doh := doc(xdb:store("/db", $output, $xmlFrag, "text/xml"))
		:)
                let $test := xdiff:compare($expected, <f>{$result}</f>)
                return
                    xqts:print-result($case/@name, $test, $query, <f>{$result}</f>, $expected, $case),
                (: Handle unexpected exceptions :)
                <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}" print="fragment-compare-unexpected-exception">
                   <exception>Exception while loading expected result fragment: {$util:exception-message}</exception>
                   <query>{$query}</query>
                </test-case>
            )
        (: Comparison method: "Inspect" :)
        (: A text compare is sufficient in many test cases :)
        else if ($output/@compare eq "Inspect") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()), "UTF-8")
            let $test := xqts:normalize-text($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)

        (: Don't know how to compare :)
      else
        <test-case name="{$case/@name}" result="error" dateRun="{util:system-time()}" print="unknown-comparison-method">
          <error test="{$case/@name}">Unknown comparison method: {$output/@compare}.</error>
          <query>{$query}</query>
	</test-case>
    (: Use this let clause to get an update insert failure from the 5314th
       test and onward in xqts:report-progress(). in-memory-temp-frag corrpution
       reproducible in xqts, who could imagine... /ljo :)
    (: let $passed := $all-results//test-case[@result eq 'pass'] :)
    let $passed :=
      if (fn:exists($all-results[2])) then
	let $result-frag := concat("<f>", fn:string-join($all-results, ""), "</f>")
	let $results-doc := doc(xdb:store("/db", "temp-res.xml", $result-frag, "text/xml"))
        return $results-doc//test-case[@result eq 'pass']
      else ()
    return
      if (fn:exists($passed)) then
	$passed[1]
      else if (fn:exists($all-results[1])) then
	$all-results[1]
      else
        (: Expected runtime-exception, but got a result :)
      if (fn:exists($case//catalog:expected-error) and fn:empty($case//catalog:output-file) and $case/@scenario eq "runtime-error") then
        <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}" print="expected-error-and-no-output">
          <expected-error>{string-join($case/catalog:expected-error/text(), ";")}</expected-error>
          <result>{$result}</result>
          <query>{$query}</query>
        </test-case>
      else
	let $log-all := util:log("DEBUG", ("Unhandled error, no result for: ", xs:string($case/@name)))
	return
	  <test-case name="{$case/@name}" result="error" dateRun="{util:system-time()}" print="unhandled-error">
    	    <error test="{$case/@name}">Cannot handle: {$case/@name}.</error>
            <query>{$query}</query>
          </test-case>

};

declare function xqts:get-variable($case as element(catalog:test-case),
	$name as xs:string) as item()* {
	let $path := concat( $xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $name, ".xq" )
	let $xq-string := util:file-read($path, "UTF-8")
	return
		if (empty($xq-string)) then
			()
		else
			util:eval($xq-string)
};

declare function xqts:run-test-case( $testCase as element(catalog:test-case)) as item()* {
   let $query := xqts:get-query($testCase)
   let $result :=
       util:catch("java.lang.Exception",
			let $context :=
				<static-context>
       			{
           			for $input in $testCase/catalog:input-file
           			return
               			<variable name="{$input/@variable}">{xqts:get-input-value($input)}</variable>,
            		for $var in $testCase/catalog:input-query
            		return
                		<variable name="{$var/@variable}">
                    		{xqts:get-variable($testCase, $var/@name)}
                		</variable>
       			}
       			</static-context>
           let $result :=
               util:eval-with-context($query, $context, false(), xqts:get-context-item($testCase/catalog:contextItem))
           return
               xqts:check-output($query, $result, $testCase),
	     (: Only expected exception and got exception.
	        No check on if it is the right exception, though. :)
           if ($testCase//catalog:expected-error and fn:empty($testCase//catalog:output-file)) then
               <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}" print="expected-exception-got-exception">
                   <exception>{$util:exception-message}</exception>
                   <expected-error>{string-join($testCase//catalog:expected-error/text(),";")}</expected-error>
                   <query>{$query}</query>
               </test-case>
           else
	     (: Expected either output or exception. :)
	     if ($testCase//catalog:expected-error and $testCase//catalog:output-file) then
               <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}" print="exception-or-output">
                   <exception>{$util:exception-message}</exception>
                   <expected-error>{string-join($testCase//catalog:expected-error/text(),";")}</expected-error>
		   {
		     for $output in $testCase//catalog:output-file
		     return <expected>{
                     let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $testCase/@FilePath, $output/text())
                     return util:file-read($filePath, "UTF-8")
                     }</expected>
		   }
                   <query>{$query}</query>
               </test-case>
           else if (fn:empty($testCase//catalog:expected-error) and $testCase//catalog:output-file) then
 	     (: Expected output, but got exception. :)
               <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}" print="expected-output-got-exception">
                   <exception>{$util:exception-message}</exception>
		   {
		     for $output in $testCase//catalog:output-file
		     return <expected>{
                     let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $testCase/@FilePath, $output/text())
                     return util:file-read($filePath, "UTF-8")
                     }</expected>
		   }
                   <query>{$query}</query>
               </test-case>
	     else
 	     (: Don't know what is expected but got here anyway. :)
               <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}" print="unhandled-result">
                   <exception>{$util:exception-message}</exception>
                   <expected-error>{string-join($testCase//catalog:expected-error/text(),";")}</expected-error>
		   {
		     if ( $testCase//catalog:output-file) then
		     for $output in $testCase//catalog:output-file
		     return <expected>{
                     let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $testCase/@FilePath, $output/text())
                     return util:file-read($filePath, "UTF-8")
                     }</expected>
		     else ()
		   }
                   <query>{$query}</query>
               </test-case>
       )
       let $log := if (fn:empty($result)) then util:log("DEBUG", ("FAILURE in-memory-frag in test: ", xs:string($testCase/@name))) else ()
   return $result
};

declare function xqts:finish($result as element()) as empty() {
    let $passed := count($result//test-case[@result = 'pass'])
    let $failed := count($result//test-case[@result = 'fail'])
    let $error := count($result//test-case[@result = 'error'])
    return (
        update value $result/@passed with xs:int($passed),
        update value $result/@failed with xs:int($failed),
        update value $result/@error with xs:int($error)
    )
};

declare function xqts:run-single-test-case($case as element(catalog:test-case),
    $resultRoot as element()?) as empty() {
    let $result := xqts:run-test-case($case)
    return (
        update insert $result into $resultRoot,
        let $added := $resultRoot/test-case[@name = $case/@name]
       let $log := if (fn:empty($added)) then util:log("DEBUG", ("FAILURE in-memory-frag in test: ", xs:string($case/@name))) else ()
        return
            if ($added) then xqts:report-progress($added)
            else ()
    )
};

declare function xqts:run-test-group($group as element(catalog:test-group)) as empty() {
    (: Create the collection hierarchy for this group and get the results.xml doc to
        append to. :)
    let $resultsDoc := xqts:create-collections($group)
    let $log-resdoc := util:log("DEBUG", ("Creating resdoc collection: ", $resultsDoc))
    let $tests := $group/catalog:test-case
(:
[
    	not(starts-with(@name, 'Constr-inscope-10')) and
    	not(starts-with(@name, 'Constr-inscope-12')) and
    	not(starts-with(@name, 'Constr-namespace-22'))
]
:)
    return (
        (: Execute the test cases :)
        for $test in $tests
        let $log := util:log("DEBUG", ("Running test case: ", string($test/@name)))
        return
            xqts:run-single-test-case($test, $resultsDoc/test-result),
        if (fn:exists($tests) and fn:exists($resultsDoc/test-result)) then
            xqts:finish($resultsDoc/test-result)
        else
            xdb:remove(util:collection-name($resultsDoc), util:document-name($resultsDoc)),
        (: Execute tests in child groups :)
        for $childGroup in $group/catalog:test-group
        let $log := util:log("DEBUG", ("Entering group: ", string($childGroup/@name)))
        return
            xqts:run-test-group($childGroup)
    )
};

declare function xqts:test-single($name as xs:string) as element() {
    let $test := //catalog:test-case[@name = $name]
    return
        if ($test) then
            let $resultsDoc := xqts:create-collections($test/parent::catalog:test-group)
            let $dummy := xqts:run-single-test-case($test, $resultsDoc/test-result)
            return
                $resultsDoc/test-result
        else
            <error>Test case not found: {$name}.</error>
};

declare function xqts:test-group($groupName as xs:string) as empty() {
    let $group := //catalog:test-group[@name = $groupName]
    return (
        xqts:create-progress-file(count($group//catalog:test-case)),
        xqts:run-test-group($group)
    )
};

declare function xqts:test-all() as empty() {
    for $test in /catalog:test-suite/catalog:test-group
    return
        xqts:test-group($test/@name)
};

declare function xqts:get-input-value($input as element(catalog:input-file)) as item()* {
   if ($input eq "emptydoc") then
       ()
   else (
       let $source := root($input)//catalog:source[@ID = $input/text()]
       return
           if (empty($source)) then
               concat("no input found: ", $input/text())
           else
               doc(concat("/db/XQTS/", $source/@FileName))
   )
};

declare function xqts:get-context-item($input as element(catalog:contextItem)?) as item()* {
	if (empty($input)) then
       ()
	else (
	   let $source := root($input)//catalog:source[@ID = $input/text()]
		return
   	   	if (empty($source)) then
			concat("no input found: ", $input/text())
       	else
			doc(concat("/db/XQTS/", $source/@FileName))
	)
};

declare function xqts:overall-result() {
    let $passed := count(//test-case[@result = "pass"])
    let $failed := count(//test-case[@result = "fail"])
    let $error := count(//test-case[@result = "error"])
    return
        <test-result failed="{$failed}" passed="{$passed}"
	    error="{$error}"
            percentage="{$passed div ($passed + $failed)}"/>
};

let $group := request:get-parameter('group', ())
return
    if ($group) then
        xqts:test-group($group)
    else
        ()