improved documentation of the node module

xquery version "1.0";

(:
 : Copyright 2006-2009 The FLWOR Foundation.
 :
 : 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.
:)

(:~
 : This module defines a set of function which can be used
 : to determine (1) the relationship between two nodes (e.g. if one
 : is the ancestor if another) and (2) properties of given
 : nodes (e.g. their level in the tree).
 :
 : The same functionality can be achieved with simple XPath expressions.
 : However, please note that using the functions in this modules instead
 : of path expressions guarantees better performance.
 :
 : @author Matthias Brantner
 : @project XDM/node
 :)
module namespace node = "http://www.zorba-xquery.com/modules/node";

declare namespace ver = "http://www.zorba-xquery.com/options/versioning";
declare option ver:module-version "2.0";

(:~
 : Determines whether the node given as second argument is an
 : ancestor of the node given as first argument.
 :
 : @param $node1 the potential descendant
 : @param $node2 the potential ancestor
 :
 : @return true if $node2 is an ancestor of $node1; false otherwise.
 :)
declare function node:ancestor-of(
  $node1 as node(),
  $node2 as node()) as xs:boolean external;

(:~
 : Determines whether the node given as second argument is a
 : descendant of the node given as first argument.
 :
 : @param $node1 the potential ancestor
 : @param $node2 the potential descendant
 :
 : @return true if $node2 is a descendant of $node1; false otherwise.
 :)
declare function node:descendant-of(
  $node1 as node(),
  $node2 as node()) as xs:boolean external;

(:~
 : Determines whether the node given as second argument is a
 : parent of the node given as first argument.
 :
 : @param $node1 the potential child
 : @param $node2 the potential parent
 :
 : @return true if $node2 is a parent of $node1; false otherwise.
 :)
declare function node:parent-of(
  $node1 as node(),
  $node2 as node()) as xs:boolean external;

(:~
 : Determines whether the node given as second argument is a
 : child of the node given as first argument.
 :
 : @param $node1 the potential parent
 : @param $node2 the potential child
 :
 : @return true if $node2 is a child of $node1; false otherwise.
 :)
declare function node:child-of(
  $node1 as node(),
  $node2 as node()) as xs:boolean external;

(:~
 : Determines whether the node given as second argument is a
 : following-sibling of the node given as first argument.
 :
 : @param $node1 the potential preceding-sibling
 : @param $node2 the potential following-sibling
 :
 : @return true if $node2 is a following-sibling of $node1; false otherwise.
 :)
declare function node:following-sibling-of(
  $node1 as node(),
  $node2 as node()) as xs:boolean external;

(:~
 : Determines whether the node given as second argument is a
 : preceding-sibling of the node given as first argument.
 :
 : @param $node1 the potential following-sibling
 : @param $node2 the potential preceding-sibling
 :
 : @return true if $node2 is a preceding-sibling of $node1; false otherwise.
 :)
declare function node:preceding-sibling-of(
  $node1 as node(),
  $node2 as node()) as xs:boolean external;

(:~
 : Determines whether the node given as second argument is
 : following the node given as first argument.
 :
 : @param $node1 the potential preceding node
 : @param $node2 the potential following node
 :
 : @return true if $node2 is following the node $node1; false otherwise.
 :)
declare function node:following-of(
  $node1 as node(),
  $node2 as node()) as xs:boolean external;

(:~
 : Determines whether the node given as second argument is
 : preceding the node given as first argument.
 :
 : @param $node1 the potential following node
 : @param $node2 the potential preceding node
 :
 : @return true if $node2 is preceding the node $node1; false otherwise.
 :)
declare function node:preceding-of(
  $node1 as node(),
  $node2 as node()) as xs:boolean external;

(:~
 : Computes the level of a given node in the tree.
 :
 : Note: The first level has the number one.
 :
 : @param $node the node for which the level should be computed
 :
 : @return The level as xs:integer of the given node in the tree.
 :)
declare function node:level(
  $node as node()) as xs:integer external;

(:~
 : Computes the least common ancestor of two given nodes in
 : the tree.
 :
 : @param $node1 the first node
 : @param $node2 the second node
 :
 : @return the least common ancestor of the two given nodes or
 :   the empty sequence if the two nodes are not part of the same
 :   tree.
 :)
declare function node:least-common-ancestor(
  $node1 as node(),
  $node2 as node()) as node()? external;

xquery version "1.0";

(:
 : Copyright 2006-2009 The FLWOR Foundation.
 :
 : 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.
:)

(:~
 : This module defines a set of function which can be used
 : to determine (1) the relationship between two nodes (e.g. if one
 : is the ancestor if another) and (2) properties of given
 : nodes (e.g. their level in the tree).
 :
 : @author Matthias Brantner
 : @project XDM/node
 :)
module namespace node = "http://www.zorba-xquery.com/modules/node";
declare namespace ver = "http://www.zorba-xquery.com/options/versioning";
declare option ver:module-version "2.0";

(:~
 : Determines whether the node given as second argument is an
 : ancestor of the node given as first argument.
 :
 : @param $node1 the potential descendant
 : @param $node2 the potential ancestor
 :
 : @return true if $node2 is an ancestor of $node1; false otherwise.
 :)
declare function node:ancestor-of(
  $node1 as node(),
  $node2 as node()) as xs:boolean external;

(:~
 : Determines whether the node given as second argument is a
 : descendant of the node given as first argument.
 :
 : @param $node1 the potential ancestor
 : @param $node2 the potential descendant
 :
 : @return true if $node2 is a descendant of $node1; false otherwise.
 :)
declare function node:descendant-of(
  $node1 as node(),
  $node2 as node()) as xs:boolean external;

(:~
 : Determines whether the node given as second argument is a
 : parent of the node given as first argument.
 :
 : @param $node1 the potential child
 : @param $node2 the potential parent
 :
 : @return true if $node2 is a parent of $node1; false otherwise.
 :)
declare function node:parent-of(
  $node1 as node(),
  $node2 as node()) as xs:boolean external;

(:~
 : Determines whether the node given as second argument is a
 : child of the node given as first argument.
 :
 : @param $node1 the potential parent
 : @param $node2 the potential child
 :
 : @return true if $node2 is a child of $node1; false otherwise.
 :)
declare function node:child-of(
  $node1 as node(),
  $node2 as node()) as xs:boolean external;

(:~
 : Determines whether the node given as second argument is a
 : following-sibling of the node given as first argument.
 :
 : @param $node1 the potential preceding-sibling
 : @param $node2 the potential following-sibling
 :
 : @return true if $node2 is a following-sibling of $node1; false otherwise.
 :)
declare function node:following-sibling-of(
  $node1 as node(),
  $node2 as node()) as xs:boolean external;

(:~
 : Determines whether the node given as second argument is a
 : preceding-sibling of the node given as first argument.
 :
 : @param $node1 the potential following-sibling
 : @param $node2 the potential preceding-sibling
 :
 : @return true if $node2 is a preceding-sibling of $node1; false otherwise.
 :)
declare function node:preceding-sibling-of(
  $node1 as node(),
  $node2 as node()) as xs:boolean external;

(:~
 : Determines whether the node given as second argument is
 : following the node given as first argument.
 :
 : @param $node1 the potential preceding node
 : @param $node2 the potential following node
 :
 : @return true if $node2 is following the node $node1; false otherwise.
 :)
declare function node:following-of(
  $node1 as node(),
  $node2 as node()) as xs:boolean external;

(:~
 : Determines whether the node given as second argument is
 : preceding the node given as first argument.
 :
 : @param $node1 the potential following node
 : @param $node2 the potential preceding node
 :
 : @return true if $node2 is preceding the node $node1; false otherwise.
 :)
declare function node:preceding-of(
  $node1 as node(),
  $node2 as node()) as xs:boolean external;

(:~
 : Computes the level of a given node in the tree.
 :
 : Note: The first level has the number one.
 :
 : @param $node the node for which the level should be computed
 :
 : @return The level as xs:integer of the given node in the tree.
 :)
declare function node:level(
  $node as node()) as xs:integer external;

(:~
 : Computes the least common ancestor of two given nodes in
 : the tree.
 :
 : @param $node1 the first node
 : @param $node2 the second node
 :
 : @return the least common ancestor of the two given nodes or
 :   the empty sequence if the two nodes are not part of the same
 :   tree.
 :)
declare function node:least-common-ancestor(
  $node1 as node(),
  $node2 as node()) as node()? external;


[testsuite] Fix undeclared variable in xqsuite test runner.

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

xquery version "3.0";

(:~
 : XQSuite - a functional test framework based on XQuery 3.0 annotations.
 : Relies on the functions util:list-functions and util:inspect-function
 : to inspect annotations. The rest is pretty much standard XQuery.
 :
 : Usage:
 :
 : <pre>
 : import module namespace test="http://exist-db.org/xquery/xqsuite" at "resource:org/exist/xquery/lib/xqsuite/xqsuite.xql";
 : import module namespace t="http://exist-db.org/xquery/test/examples" at "examples.xql";
 :
 : test:suite(util:list-functions("http://exist-db.org/xquery/test/examples"))
 : </pre>
 :
 : @author Wolfgang Meier
 :)
module namespace test="http://exist-db.org/xquery/xqsuite";

declare variable $test:TEST_NAMESPACE := "http://exist-db.org/xquery/xqsuite";

declare variable $test:UNKNOWN_ASSERTION := QName($test:TEST_NAMESPACE, "no-such-assertion");
declare variable $test:WRONG_ARG_COUNT := QName($test:TEST_NAMESPACE, "wrong-number-of-arguments");
declare variable $test:TYPE_ERROR := QName($test:TEST_NAMESPACE, "type-error");

(:~
 : Main entry point into the module. Takes a sequence of function items.
 : Functions with known test annotations will be evaluated and their results
 : checked against the annotations.
 :
 : @param $functions a sequence of function items
 : @return an XML report (in xUnit format)
 :)
declare function test:suite($functions as function(*)+) {
    let $modules := test:distinct-modules($functions)
    return
        <testsuites>
        {
            (: Run tests for each module in turn :)
            for $module in $modules
            let $modFunctions := filter(function($func) {
                    namespace-uri-from-QName(function-name($func)) = $module
                }, $functions)
            let $setup := test:call-func-with-annotation($modFunctions, "setUp")
            let $result :=
                if (empty($setup) or $setup/self::ok) then
                    let $startTime := util:system-time()
                    let $results :=
                        test:function-by-annotation($modFunctions, "assert", test:run-tests#2)
                    let $elapsed :=
                        util:system-time() - $startTime
                    return
                        <testsuite package="{$module}" timestamp="{util:system-dateTime()}"
                            failures="{count($results/failure)}" tests="{count($results)}"
                            time="{$elapsed}">
                            { $results }
                        </testsuite>
                else
                    <testsuite package="{$module}" timestamp="{util:system-dateTime()}"
                        errors="{count($functions)}">
                        {$setup/string()}
                    </testsuite>
            return
                ($result, test:call-func-with-annotation($modFunctions, "tearDown"))[1]
        }
        </testsuites>
};

(:~
 : Find functions having the given annotation and call the callback function.
 :)
declare %private function test:function-by-annotation($functions as function(*)+, $annot as xs:string,
    $callback as function(function(*), element(function)) as item()*) {
    for $function in $functions
    let $meta := util:inspect-function($function)
    where $meta/annotation[@namespace = $test:TEST_NAMESPACE][matches(@name, ":" || $annot)]
    return
        $callback($function, $meta)
};

(:~
 : Return the namespace URI of all distinct modules in the input set.
 :)
declare %private function test:distinct-modules($functions as function(*)+) as xs:string+ {
    distinct-values(
        for $func in $functions
        return
            namespace-uri-from-QName(function-name($func))
    )
};

(:~
 : Find functions having the specified annotation and call them,
 : return <ok/> upon success, an error description otherwise.
 : Used for setUp and tearDown.
 :)
declare %private function test:call-func-with-annotation($functions as function(*)+, $annot as xs:string) as element()? {
    test:function-by-annotation($functions, $annot, function($func, $meta) {
        try {
            (<ok/>, $func())[1]
        } catch * {
            <system-err>{$err:description}</system-err>
        }
    })
};

(:~
 : Calls the test function one or more times, depending on the number of
 : %args() annotations found. Each %arg annotation triggers one test run
 : using the supplied parameters.
 :)
declare %private function test:run-tests($func as function(*), $meta as element(function)) {
    let $argsAnnot := $meta/annotation[matches(@name, ":args?")][not(preceding-sibling::annotation[1][matches(@name, ":args?")])]
    return
        if ($argsAnnot) then
            $argsAnnot ! test:test($func, $meta, .)
        else
            test:test($func, $meta, ())
};

(:~
 : The main function for running a single test. Executes the test function
 : and compares the result against each assertXXX annotation.
 :)
declare %private function test:test($func as function(*), $meta as element(function), $firstArg as element(annotation)?) {
    let $args := test:get-run-args($firstArg)
    let $assertions := test:get-assertions($meta, $firstArg)
    let $assertError := $assertions[contains(@name, ":assertError")]
    return
        if (exists($assertions)) then
            try {
                let $result := test:call-test($func, $meta, $args)
                let $assertResult := test:check-assertions($assertions, $result)
                return
                    if ($assertError) then
                        test:print-result($meta, $result,
                            <report>
                                <failure message="Expected error {$assertError/value/string()}."
                                    type="failure-error-code-1"/>
                            </report>
                        )
                    else
                        test:print-result($meta, $result, $assertResult)
            } catch * {
                if ($assertError) then
                    if ($assertError/value and not(contains($err:code, $assertError/value/string())
                        or matches($err:description, $assertError/value/string())))then
                        test:print-result($meta, (),
                            <report>
                                <failure message="Expected error {$assertError/value/string()}, got: {$err:code} {$err:description}"
                                    type="failure-error-code-1"/>
                            </report>
                        )
                    else
                        test:print-result($meta, (), ())
                else
                    test:print-result($meta, (),
                        <report>
                            <error type="{$err:code}" message="{$err:description}"/>
                        </report>
                    )
            }
        else
            ()
};

(:~
 : Get all %assertXXX annotations of the function. If %args is used multiple times,
 : assertions apply to the result of running the function with the parameters given
 : in the preceding %args.
 :)
declare %private function test:get-assertions($meta as element(function), $firstArg as element(annotation)?) {
    if ($firstArg) then
        let $nextBlock :=
            $firstArg/following-sibling::annotation[matches(@name, ":args?")]
                [preceding-sibling::annotation[1][contains(@name, ":assert")]][1]
        return
            if ($nextBlock) then
                $firstArg/following-sibling::annotation[contains(@name, ":assert")]
                intersect
                $nextBlock/preceding-sibling::annotation[contains(@name, ":assert")]
            else
                $firstArg/following-sibling::annotation[contains(@name, ":assert")]
    else
        $meta/annotation[contains(@name, ":assert")]
};

(:~
 : Collect %test:arg and %test:args for the current run.
 :)
declare %private function test:get-run-args($firstArg as element(annotation)?) {
    if ($firstArg) then
        let $nextBlock :=
            $firstArg/following-sibling::annotation[matches(@name, ":args?")]
                [preceding-sibling::annotation[1][contains(@name, ":assert")]][1]
        return (
            $firstArg,
            if ($nextBlock) then
                $firstArg/following-sibling::annotation[matches(@name, ":args?")]
                intersect
                $nextBlock/preceding-sibling::annotation
            else
                $firstArg/following-sibling::annotation[matches(@name, ":args?")]
        )
    else
        ()
};

(:~
 : Map any arguments from the %args or %arg annotations into function parameters and evaluate
 : the resulting function.
 :)
declare %private function test:call-test($func as function(*), $meta as element(function), $args as element(annotation)*) {
    let $funArgs :=
        if ($args[1]/@name = "test:args") then
            test:map-arguments($args/value/string(), $meta/argument)
        else
            test:map-named-arguments($meta/argument, $args)
    return
        test:apply($func, $meta, $funArgs)
};

(:~
 : Map a sequence of %arg annotations to named function parameters.
 :)
declare %private function test:map-named-arguments($funcArgs as element(argument)*, $testArgs as element(annotation)*) {
    let $mappedArgs :=
        for $arg in $funcArgs
        let $argName := $arg/@var/string()
        let $testArg := $testArgs[value[1] = $argName]
        return
            if (empty($testArg)) then
                error($test:WRONG_ARG_COUNT, "No matching %test:arg found for parameter " || $argName)
            else
                test:map-named-argument(subsequence($testArg/value, 2), $arg)
    return
        if (count($mappedArgs) != count($funcArgs)) then
            error(
                $test:WRONG_ARG_COUNT,
                "The number of arguments specified via test:arg must match the arguments of the function to test"
            )
        else
            $mappedArgs
};

declare %private function test:map-named-argument($testArgs as element(value)*, $funcArg as element(argument)) {
    let $data :=
        try {
            test:cast($testArgs, $funcArg)
        } catch * {
            error($test:TYPE_ERROR, "Failed to cast annotation arguments to required target type " || $funcArg/@type)
        }
    return
        (: If we need to return a sequence of values, enclose them into a closure function :)
        function() { $data }
};

(:~
 : For %args: transform each annotation parameter into the type required for the function parameter.
 :)
declare %private function test:map-arguments($testArgs as xs:string*, $funcArgs as element(argument)*) {
    if (exists($testArgs)) then
        if (count($testArgs) != count($funcArgs)) then
            error(
                $test:WRONG_ARG_COUNT,
                "The number of arguments specified in test:args must match the arguments of the function to test"
            )
        else
            map-pairs(function($targ as xs:string, $farg as element(argument)) {
                let $data := test:cast($targ, $farg)
                return
                    function() { $data }
            }, $testArgs, $funcArgs)
    else
        ()
};

declare %private function test:cast($targs as xs:string*, $farg as element(argument)) {
    for $targ in $targs
    return
        switch (string($farg/@type))
            case "xs:string" return
                string($targ)
            case "xs:integer" case "xs:int" return
                xs:integer($targ)
            case "xs:decimal" return
                xs:decimal($targ)
            case "xs:float" case "xs:double" return
                xs:double($targ)
            case "xs:date" return
                xs:date($targ)
            case "xs:dateTime" return
                xs:dateTime($targ)
            case "xs:time" return
                xs:time($targ)
            case "element()" return
                util:parse($targ)/*
            case "text()" return
                text { string($targ) }
            default return
                $targ
};

declare function test:apply($func as function(*), $meta as element(function), $args as item()*) {
    let $userAnno := $meta/annotation[contains(@name, ":user")]
    return
        if ($userAnno) then
            let $user := $userAnno/value[1]/string()
            let $pass := $userAnno/value[2]/string()
            return
                system:as-user($user, $pass, test:apply($func, $args))
        else
            test:apply($func, $args)
};

(:~
 : Call the given function with parameters taken from $args.
 :)
declare %private function test:apply($func as function(*), $args as item()*) {
    switch (count($args))
        case 0 return
            $func()
        case 1 return
            $func($args[1]())
        case 2 return
            $func($args[1](), $args[2]())
        case 3 return
            $func($args[1](), $args[2](), $args[3]())
        case 4 return
            $func($args[1](), $args[2](), $args[3](), $args[4]())
        case 5 return
            $func($args[1](), $args[2](), $args[3](), $args[4](), $args[5]())
        case 6 return
            $func($args[1](), $args[2](), $args[3](), $args[4](), $args[5](), $args[6]())
        case 7 return
            $func($args[1](), $args[2](), $args[3](), $args[4](), $args[5](), $args[6](), $args[7]())
        default return
            error($test:WRONG_ARG_COUNT, "Function takes too many arguments")
};

(:~
 : Print out evaluation results for a given test.
 :)
declare %private function test:print-result($meta as element(function), $result as item()*,
    $assertResult as element(report)*) {
    let $nameAnnot := $meta/annotation[matches(@name, ":name")]
    let $name := if ($nameAnnot) then $nameAnnot/value else replace($meta/@name, "^\w+:([^:]+)$", "$1")
    return
        <testcase name="{$name}" class="{$meta/@name}">
        {
            if (exists($assertResult)) then
                ($assertResult[failure] | $assertResult)[1]/*
            else
                ()
        }
        </testcase>
};

(:~
 : Check the function's return value against each assertion.
 :)
declare %private function test:check-assertions($assertions as element(annotation)*, $result as item()*) as element(report)* {
    for $annotation in $assertions
    let $assert := replace($annotation/@name, "^\w+:(.*)$", "$1")
    return
        switch ($assert)
            case "assertEquals" return
                test:assertEquals($annotation/value/string(), $result)
            case "assertEqualsPermutation" return
                test:assertEqualsPermutation($annotation/value/string(), $result)
            case "assertEmpty" return
                test:assertEmpty($result)
            case "assertExists" return
                test:assertExists($result)
            case "assertTrue" return
                test:assertTrue($result)
            case "assertFalse" return
                test:assertFalse($result)
            case "assertXPath" return
                test:assertXPath($annotation, $result)
            case "assertError" return
                test:assertError($annotation/value/string(), $result)
            default return
                error($test:UNKNOWN_ASSERTION, $annotation/@name)
};

(:~
 : Check for equality of the function's result with the value in the annotation.
 : This function transforms the result to a string before checking for equality.
 :)
declare %private function test:assertEquals($values as item()*, $result as item()*) as element(report)? {
    if (exists($values)) then
        if (count($values) eq count($result)) then
            let $tests := map-pairs(test:equals#2, $values, $result)
            let $equal := every $test in $tests satisfies $test
            return
                if ($equal) then
                    ()
                else
                   <report>
                        <failure message="assertEquals failed."
                            type="failure-error-code-1">
                        { $values }
                        </failure>
                        <output>{ $result }</output>
                    </report>
        else
            <report>
                <failure message="assertEquals failed: wrong number of items returned by function. Expected: {count($values)}. Got: {count($result)}"
                    type="failure-error-code-1">
                { $values }
                </failure>
                <output>{ $result }</output>
            </report>
    else
        ()
};

(:~
 : Check for equality of the function's result with the value in the annotation.
 : This function transforms the result to a string before checking for equality.
 :)
declare %private function test:assertEqualsPermutation($values as item()*, $result as item()*) as element(report)? {
    if (exists($values)) then
        if (count($values) eq count($result)) then
            let $tests :=
                for $item in $result
                return
                    some $value in $values satisfies test:equals($item, $value)
            let $equal := every $test in $tests satisfies $test
            return
                if ($equal) then
                    ()
                else
                   <report>
                        <failure message="assertEquals failed."
                            type="failure-error-code-1">
                        { $values }
                        </failure>
                        <output>{ $result }</output>
                    </report>
        else
            <report>
                <failure message="assertEquals failed: wrong number of items returned by function. Expected: {count($values)}. Got: {count($result)}"
                    type="failure-error-code-1">
                { $values }
                </failure>
                <output>{ $result }</output>
            </report>
    else
        ()
};

declare %private function test:equals($value as item(), $result as item()) as xs:boolean {
    let $normResult :=
        typeswitch ($result)
            case node() return
                test:normalize($result)
            default return
                $result
    let $normValue := test:cast-to-type($value, $result)
    return
        typeswitch ($normResult)
            case node() return
                deep-equal($normValue, $normResult)
            default return
                $normResult eq $normValue
};

declare %private function test:normalize($nodes as node()*) {
    $nodes ! test:normalize-node(.)
};

declare %private function test:normalize-node($node as node()) {
    typeswitch ($node)
        case document-node() return
            test:normalize-node($node/*)
        case element() return
            element { node-name($node) } {
                $node/@*, for $child in $node/node() return test:normalize-node($child)
            }
        case text() return
            let $norm := normalize-space($node)
            return
                if (string-length($norm) eq 0) then () else $node
        default return
            $node
};

(:~
 : Check if the function's result is empty.
 :)
declare %private function test:assertEmpty($result as item()*) as element(report)? {
    if (empty($result)) then
        ()
    else
        <report>
            <failure message="assertEmpty failed."
                type="failure-error-code-1"/>,
            <output>{ $result }</output>
        </report>
};

(:~
 : Check if the function's result is not empty.
 :)
declare %private function test:assertExists($result as item()*) as element(report)? {
    if (exists($result)) then
        ()
    else
        <report>
            <failure message="assertExists failed."
                type="failure-error-code-1"/>,
            <output>{ $result }</output>
        </report>
};

(:~
 : Check if the function's result is true.
 :)
declare %private function test:assertTrue($result as item()*) as element(report)? {
    if ($result) then
        ()
    else
        <report>
            <failure message="assertExists failed."
                type="failure-error-code-1"/>,
            <output>{ $result }</output>
        </report>
};

(:~
 : Check if the function caused an error.
 :)
declare %private function test:assertError($value as xs:string, $result as item()*) as element(report)? {
    if ($result) then
        ()
    else
        <report>
            <failure message="assertError failed. Expected error {$value}"
                type="failure-error-code-1"/>,
            <output>{ $result }</output>
        </report>
};

(:~
 : Check if the function's result is false.
 :)
declare %private function test:assertFalse($result as item()*) as element(report)? {
    if (not($result)) then
        ()
    else
        <report>
            <failure message="assertExists failed."
                type="failure-error-code-1"/>,
            <output>{ $result }</output>
        </report>
};

(:~
 : Evaluate an arbitrary XPath expression against result. The test passes if
 : the XPath returns either true or a non-empty sequence.
 :)
declare %private function test:assertXPath($annotation as element(annotation), $output as item()*) as element(report)? {
    let $expr := $annotation/value[1]/string()
    let $result :=
        if (count($annotation/value) = 2 and boolean($annotation/value[2])) then
            util:expand($output)
        else
            $output
    let $xr :=
        test:checkXPathResult(
            if (matches($expr, "^\s*/")) then
                util:eval(concat("$result", $expr))
            else
                util:eval($expr)
        )
    return
        if ($xr) then
            ()
        else
            <report>
                <failure message="assertXPath failed."
                    type="failure-error-code-1">{ $expr }</failure>,
                <output>{ $result }</output>
            </report>
};

declare %private function test:checkXPathResult($result as item()*) {
    if ($result instance of xs:boolean) then
        $result
    else
        exists($result)
};

declare %private function test:cast-to-type($value as item(), $result as item()) {
    typeswitch ($result)
        case node() return
            util:parse("<r>" || $value || "</r>")/r/node()
        case xs:integer return
            xs:integer($value)
        case xs:int return
            xs:int($value)
        case xs:long return
            xs:long($value)
        case xs:decimal return
            xs:decimal($value)
        case xs:double return
            xs:double($value)
        case xs:float return
            xs:float($value)
        case xs:date return
            xs:date($value)
        case xs:dateTime return
            xs:dateTime($value)
        case xs:time return
            xs:time($value)
        case xs:boolean return
            xs:boolean($value)
        case xs:anyURI return
            xs:anyURI($value)
        default return
            string($value)
};

(: Helper functions to be used by test modules :)

declare function test:mkcol($root as xs:string, $path as xs:string) as empty() {
    test:mkcol-recursive($root, tokenize($path, "/"))
};

declare %private function test:mkcol-recursive($collection, $components) as empty() {
    if (exists($components)) then
        let $newColl := concat($collection, "/", $components[1])
        return (
            xmldb:create-collection($collection, $components[1])[2],
            test:mkcol-recursive($newColl, subsequence($components, 2))
        )
    else
        ()
};

declare function test:to-html($output as element(testsuites)) {
    <div class="testresult">
    {
        $output/testsuite !
            <section>
                <h2>{@package/string()}</h2>
                <table>
                {
                    for $case in testcase
                    return
                        test:print-testcase($case)
                }
                </table>
            </section>
    }
    </div>
};

declare %private function test:print-testcase($case as element(testcase)) {
    <tr class="{if ($case/failure) then 'fail' else 'pass'}">
        <td>{$case/@name/string()}</td>
        <td>
        {
            if ($case/failure) then
                ($case/failure/@message/string(), " Expected: ", $case/failure/text())
            else
                "OK"
        }
        </td>
    </tr>
};

xquery version "3.0";

(:~
 : XQSuite - a functional test framework based on XQuery 3.0 annotations.
 : Relies on the functions util:list-functions and util:inspect-function
 : to inspect annotations. The rest is pretty much standard XQuery.
 :
 : Usage:
 :
 : <pre>
 : import module namespace test="http://exist-db.org/xquery/xqsuite" at "resource:org/exist/xquery/lib/xqsuite/xqsuite.xql";
 : import module namespace t="http://exist-db.org/xquery/test/examples" at "examples.xql";
 :
 : test:suite(util:list-functions("http://exist-db.org/xquery/test/examples"))
 : </pre>
 :
 : @author Wolfgang Meier
 :)
module namespace test="http://exist-db.org/xquery/xqsuite";

declare variable $test:TEST_NAMESPACE := "http://exist-db.org/xquery/xqsuite";

declare variable $test:UNKNOWN_ASSERTION := QName($test:TEST_NAMESPACE, "no-such-assertion");
declare variable $test:WRONG_ARG_COUNT := QName($test:TEST_NAMESPACE, "wrong-number-of-arguments");

(:~
 : Main entry point into the module. Takes a sequence of function items.
 : Functions with known test annotations will be evaluated and their results
 : checked against the annotations.
 :
 : @param $functions a sequence of function items
 : @return an XML report (in xUnit format)
 :)
declare function test:suite($functions as function(*)+) {
    let $modules := test:distinct-modules($functions)
    return
        <testsuites>
        {
            (: Run tests for each module in turn :)
            for $module in $modules
            let $modFunctions := filter(function($func) {
                    namespace-uri-from-QName(function-name($func)) = $module
                }, $functions)
            let $setup := test:call-func-with-annotation($modFunctions, "setUp")
            let $result :=
                if (empty($setup) or $setup/self::ok) then
                    let $startTime := util:system-time()
                    let $results :=
                        test:function-by-annotation($modFunctions, "assert", test:run-tests#2)
                    let $elapsed :=
                        util:system-time() - $startTime
                    return
                        <testsuite package="{$module}" timestamp="{util:system-dateTime()}"
                            failures="{count($results/failure)}" tests="{count($results)}"
                            time="{$elapsed}">
                            { $results }
                        </testsuite>
                else
                    <testsuite package="{$module}" timestamp="{util:system-dateTime()}"
                        errors="{count($functions)}">
                        {$setup/string()}
                    </testsuite>
            return
                ($result, test:call-func-with-annotation($modFunctions, "tearDown"))[1]
        }
        </testsuites>
};

(:~
 : Find functions having the given annotation and call the callback function.
 :)
declare %private function test:function-by-annotation($functions as function(*)+, $annot as xs:string,
    $callback as function(function(*), element(function)) as item()*) {
    for $function in $functions
    let $meta := util:inspect-function($function)
    where $meta/annotation[@namespace = $test:TEST_NAMESPACE][matches(@name, ":" || $annot)]
    return
        $callback($function, $meta)
};

(:~
 : Return the namespace URI of all distinct modules in the input set.
 :)
declare %private function test:distinct-modules($functions as function(*)+) as xs:string+ {
    distinct-values(
        for $func in $functions
        return
            namespace-uri-from-QName(function-name($func))
    )
};

(:~
 : Find functions having the specified annotation and call them,
 : return <ok/> upon success, an error description otherwise.
 : Used for setUp and tearDown.
 :)
declare %private function test:call-func-with-annotation($functions as function(*)+, $annot as xs:string) as element()? {
    test:function-by-annotation($functions, $annot, function($func, $meta) {
        try {
            (<ok/>, $func())[1]
        } catch * {
            <system-err>{$err:description}</system-err>
        }
    })
};

(:~
 : Calls the test function one or more times, depending on the number of
 : %args() annotations found. Each %arg annotation triggers one test run
 : using the supplied parameters.
 :)
declare %private function test:run-tests($func as function(*), $meta as element(function)) {
    let $argsAnnot := $meta/annotation[matches(@name, ":args?")][not(preceding-sibling::annotation[1][matches(@name, ":args?")])]
    return
        if ($argsAnnot) then
            $argsAnnot ! test:test($func, $meta, .)
        else
            test:test($func, $meta, ())
};

(:~
 : The main function for running a single test. Executes the test function
 : and compares the result against each assertXXX annotation.
 :)
declare %private function test:test($func as function(*), $meta as element(function), $firstArg as element(annotation)?) {
    let $args := test:get-run-args($firstArg)
    let $assertions := test:get-assertions($meta, $firstArg)
    let $assertError := $assertions[contains(@name, ":assertError")]
    return
        if (exists($assertions)) then
            try {
                let $result := test:call-test($func, $meta, $args)
                let $assertResult := test:check-assertions($assertions, $result)
                return
                    if ($assertError) then
                        test:print-result($meta, $result,
                            <report>
                                <failure message="Expected error {$assertError/value/string()}."
                                    type="failure-error-code-1"/>
                            </report>
                        )
                    else
                        test:print-result($meta, $result, $assertResult)
            } catch * {
                if ($assertError) then
                    if ($assertError/value and not(contains($err:code, $assertError/value/string())
                        or matches($err:description, $assertError/value/string())))then
                        test:print-result($meta, (),
                            <report>
                                <failure message="Expected error {$assertError/value/string()}, got: {$err:code} {$err:description}"
                                    type="failure-error-code-1"/>
                            </report>
                        )
                    else
                        test:print-result($meta, (), ())
                else
                    test:print-result($meta, (),
                        <report>
                            <error type="{$err:code}" message="{$err:description}"/>
                        </report>
                    )
            }
        else
            ()
};

(:~
 : Get all %assertXXX annotations of the function. If %args is used multiple times,
 : assertions apply to the result of running the function with the parameters given
 : in the preceding %args.
 :)
declare %private function test:get-assertions($meta as element(function), $firstArg as element(annotation)?) {
    if ($firstArg) then
        let $nextBlock :=
            $firstArg/following-sibling::annotation[matches(@name, ":args?")]
                [preceding-sibling::annotation[1][contains(@name, ":assert")]][1]
        return
            if ($nextBlock) then
                $firstArg/following-sibling::annotation[contains(@name, ":assert")]
                intersect
                $nextBlock/preceding-sibling::annotation[contains(@name, ":assert")]
            else
                $firstArg/following-sibling::annotation[contains(@name, ":assert")]
    else
        $meta/annotation[contains(@name, ":assert")]
};

(:~
 : Collect %test:arg and %test:args for the current run.
 :)
declare %private function test:get-run-args($firstArg as element(annotation)?) {
    if ($firstArg) then
        let $nextBlock :=
            $firstArg/following-sibling::annotation[matches(@name, ":args?")]
                [preceding-sibling::annotation[1][contains(@name, ":assert")]][1]
        return (
            $firstArg,
            if ($nextBlock) then
                $firstArg/following-sibling::annotation[matches(@name, ":args?")]
                intersect
                $nextBlock/preceding-sibling::annotation
            else
                $firstArg/following-sibling::annotation[matches(@name, ":args?")]
        )
    else
        ()
};

(:~
 : Map any arguments from the %args or %arg annotations into function parameters and evaluate
 : the resulting function.
 :)
declare %private function test:call-test($func as function(*), $meta as element(function), $args as element(annotation)*) {
    let $funArgs :=
        if ($args[1]/@name = "test:args") then
            test:map-arguments($args/value/string(), $meta/argument)
        else
            test:map-named-arguments($meta/argument, $args)
    return
        test:apply($func, $meta, $funArgs)
};

(:~
 : Map a sequence of %arg annotations to named function parameters.
 :)
declare %private function test:map-named-arguments($funcArgs as element(argument)*, $testArgs as element(annotation)*) {
    let $mappedArgs :=
        for $arg in $funcArgs
        let $argName := $arg/@var/string()
        let $testArg := $testArgs[value[1] = $argName]
        return
            if (empty($testArg)) then
                error($test:WRONG_ARG_COUNT, "No matching %test:arg found for parameter " || $argName)
            else
                test:map-named-argument(subsequence($testArg/value, 2), $arg)
    return
        if (count($mappedArgs) != count($funcArgs)) then
            error(
                $test:WRONG_ARG_COUNT,
                "The number of arguments specified via test:arg must match the arguments of the function to test"
            )
        else
            $mappedArgs
};

declare %private function test:map-named-argument($testArgs as element(value)*, $funcArg as element(argument)) {
    let $data :=
        try {
            test:cast($testArgs, $funcArg)
        } catch * {
            error($test:TYPE_ERROR, "Failed to cast annotation arguments to required target type " || $funcArg/@type)
        }
    return
        (: If we need to return a sequence of values, enclose them into a closure function :)
        function() { $data }
};

(:~
 : For %args: transform each annotation parameter into the type required for the function parameter.
 :)
declare %private function test:map-arguments($testArgs as xs:string*, $funcArgs as element(argument)*) {
    if (exists($testArgs)) then
        if (count($testArgs) != count($funcArgs)) then
            error(
                $test:WRONG_ARG_COUNT,
                "The number of arguments specified in test:args must match the arguments of the function to test"
            )
        else
            map-pairs(function($targ as xs:string, $farg as element(argument)) {
                let $data := test:cast($targ, $farg)
                return
                    function() { $data }
            }, $testArgs, $funcArgs)
    else
        ()
};

declare %private function test:cast($targs as xs:string*, $farg as element(argument)) {
    for $targ in $targs
    return
        switch (string($farg/@type))
            case "xs:string" return
                string($targ)
            case "xs:integer" case "xs:int" return
                xs:integer($targ)
            case "xs:decimal" return
                xs:decimal($targ)
            case "xs:float" case "xs:double" return
                xs:double($targ)
            case "xs:date" return
                xs:date($targ)
            case "xs:dateTime" return
                xs:dateTime($targ)
            case "xs:time" return
                xs:time($targ)
            case "element()" return
                util:parse($targ)/*
            case "text()" return
                text { string($targ) }
            default return
                $targ
};

declare function test:apply($func as function(*), $meta as element(function), $args as item()*) {
    let $userAnno := $meta/annotation[contains(@name, ":user")]
    return
        if ($userAnno) then
            let $user := $userAnno/value[1]/string()
            let $pass := $userAnno/value[2]/string()
            return
                system:as-user($user, $pass, test:apply($func, $args))
        else
            test:apply($func, $args)
};

(:~
 : Call the given function with parameters taken from $args.
 :)
declare %private function test:apply($func as function(*), $args as item()*) {
    switch (count($args))
        case 0 return
            $func()
        case 1 return
            $func($args[1]())
        case 2 return
            $func($args[1](), $args[2]())
        case 3 return
            $func($args[1](), $args[2](), $args[3]())
        case 4 return
            $func($args[1](), $args[2](), $args[3](), $args[4]())
        case 5 return
            $func($args[1](), $args[2](), $args[3](), $args[4](), $args[5]())
        case 6 return
            $func($args[1](), $args[2](), $args[3](), $args[4](), $args[5](), $args[6]())
        case 7 return
            $func($args[1](), $args[2](), $args[3](), $args[4](), $args[5](), $args[6](), $args[7]())
        default return
            error($test:WRONG_ARG_COUNT, "Function takes too many arguments")
};

(:~
 : Print out evaluation results for a given test.
 :)
declare %private function test:print-result($meta as element(function), $result as item()*,
    $assertResult as element(report)*) {
    let $nameAnnot := $meta/annotation[matches(@name, ":name")]
    let $name := if ($nameAnnot) then $nameAnnot/value else replace($meta/@name, "^\w+:([^:]+)$", "$1")
    return
        <testcase name="{$name}" class="{$meta/@name}">
        {
            if (exists($assertResult)) then
                ($assertResult[failure] | $assertResult)[1]/*
            else
                ()
        }
        </testcase>
};

(:~
 : Check the function's return value against each assertion.
 :)
declare %private function test:check-assertions($assertions as element(annotation)*, $result as item()*) as element(report)* {
    for $annotation in $assertions
    let $assert := replace($annotation/@name, "^\w+:(.*)$", "$1")
    return
        switch ($assert)
            case "assertEquals" return
                test:assertEquals($annotation/value/string(), $result)
            case "assertEqualsPermutation" return
                test:assertEqualsPermutation($annotation/value/string(), $result)
            case "assertEmpty" return
                test:assertEmpty($result)
            case "assertExists" return
                test:assertExists($result)
            case "assertTrue" return
                test:assertTrue($result)
            case "assertFalse" return
                test:assertFalse($result)
            case "assertXPath" return
                test:assertXPath($annotation, $result)
            case "assertError" return
                test:assertError($annotation/value/string(), $result)
            default return
                error($test:UNKNOWN_ASSERTION, $annotation/@name)
};

(:~
 : Check for equality of the function's result with the value in the annotation.
 : This function transforms the result to a string before checking for equality.
 :)
declare %private function test:assertEquals($values as item()*, $result as item()*) as element(report)? {
    if (exists($values)) then
        if (count($values) eq count($result)) then
            let $tests := map-pairs(test:equals#2, $values, $result)
            let $equal := every $test in $tests satisfies $test
            return
                if ($equal) then
                    ()
                else
                   <report>
                        <failure message="assertEquals failed."
                            type="failure-error-code-1">
                        { $values }
                        </failure>
                        <output>{ $result }</output>
                    </report>
        else
            <report>
                <failure message="assertEquals failed: wrong number of items returned by function. Expected: {count($values)}. Got: {count($result)}"
                    type="failure-error-code-1">
                { $values }
                </failure>
                <output>{ $result }</output>
            </report>
    else
        ()
};

(:~
 : Check for equality of the function's result with the value in the annotation.
 : This function transforms the result to a string before checking for equality.
 :)
declare %private function test:assertEqualsPermutation($values as item()*, $result as item()*) as element(report)? {
    if (exists($values)) then
        if (count($values) eq count($result)) then
            let $tests :=
                for $item in $result
                return
                    some $value in $values satisfies test:equals($item, $value)
            let $equal := every $test in $tests satisfies $test
            return
                if ($equal) then
                    ()
                else
                   <report>
                        <failure message="assertEquals failed."
                            type="failure-error-code-1">
                        { $values }
                        </failure>
                        <output>{ $result }</output>
                    </report>
        else
            <report>
                <failure message="assertEquals failed: wrong number of items returned by function. Expected: {count($values)}. Got: {count($result)}"
                    type="failure-error-code-1">
                { $values }
                </failure>
                <output>{ $result }</output>
            </report>
    else
        ()
};

declare %private function test:equals($value as item(), $result as item()) as xs:boolean {
    let $normResult :=
        typeswitch ($result)
            case node() return
                test:normalize($result)
            default return
                $result
    let $normValue := test:cast-to-type($value, $result)
    return
        typeswitch ($normResult)
            case node() return
                deep-equal($normValue, $normResult)
            default return
                $normResult eq $normValue
};

declare %private function test:normalize($nodes as node()*) {
    $nodes ! test:normalize-node(.)
};

declare %private function test:normalize-node($node as node()) {
    typeswitch ($node)
        case document-node() return
            test:normalize-node($node/*)
        case element() return
            element { node-name($node) } {
                $node/@*, for $child in $node/node() return test:normalize-node($child)
            }
        case text() return
            let $norm := normalize-space($node)
            return
                if (string-length($norm) eq 0) then () else $node
        default return
            $node
};

(:~
 : Check if the function's result is empty.
 :)
declare %private function test:assertEmpty($result as item()*) as element(report)? {
    if (empty($result)) then
        ()
    else
        <report>
            <failure message="assertEmpty failed."
                type="failure-error-code-1"/>,
            <output>{ $result }</output>
        </report>
};

(:~
 : Check if the function's result is not empty.
 :)
declare %private function test:assertExists($result as item()*) as element(report)? {
    if (exists($result)) then
        ()
    else
        <report>
            <failure message="assertExists failed."
                type="failure-error-code-1"/>,
            <output>{ $result }</output>
        </report>
};

(:~
 : Check if the function's result is true.
 :)
declare %private function test:assertTrue($result as item()*) as element(report)? {
    if ($result) then
        ()
    else
        <report>
            <failure message="assertExists failed."
                type="failure-error-code-1"/>,
            <output>{ $result }</output>
        </report>
};

(:~
 : Check if the function caused an error.
 :)
declare %private function test:assertError($value as xs:string, $result as item()*) as element(report)? {
    if ($result) then
        ()
    else
        <report>
            <failure message="assertError failed. Expected error {$value}"
                type="failure-error-code-1"/>,
            <output>{ $result }</output>
        </report>
};

(:~
 : Check if the function's result is false.
 :)
declare %private function test:assertFalse($result as item()*) as element(report)? {
    if (not($result)) then
        ()
    else
        <report>
            <failure message="assertExists failed."
                type="failure-error-code-1"/>,
            <output>{ $result }</output>
        </report>
};

(:~
 : Evaluate an arbitrary XPath expression against result. The test passes if
 : the XPath returns either true or a non-empty sequence.
 :)
declare %private function test:assertXPath($annotation as element(annotation), $output as item()*) as element(report)? {
    let $expr := $annotation/value[1]/string()
    let $result :=
        if (count($annotation/value) = 2 and boolean($annotation/value[2])) then
            util:expand($output)
        else
            $output
    let $xr :=
        test:checkXPathResult(
            if (matches($expr, "^\s*/")) then
                util:eval(concat("$result", $expr))
            else
                util:eval($expr)
        )
    return
        if ($xr) then
            ()
        else
            <report>
                <failure message="assertXPath failed."
                    type="failure-error-code-1">{ $expr }</failure>,
                <output>{ $result }</output>
            </report>
};

declare %private function test:checkXPathResult($result as item()*) {
    if ($result instance of xs:boolean) then
        $result
    else
        exists($result)
};

declare %private function test:cast-to-type($value as item(), $result as item()) {
    typeswitch ($result)
        case node() return
            util:parse("<r>" || $value || "</r>")/r/node()
        case xs:integer return
            xs:integer($value)
        case xs:int return
            xs:int($value)
        case xs:long return
            xs:long($value)
        case xs:decimal return
            xs:decimal($value)
        case xs:double return
            xs:double($value)
        case xs:float return
            xs:float($value)
        case xs:date return
            xs:date($value)
        case xs:dateTime return
            xs:dateTime($value)
        case xs:time return
            xs:time($value)
        case xs:boolean return
            xs:boolean($value)
        case xs:anyURI return
            xs:anyURI($value)
        default return
            string($value)
};

(: Helper functions to be used by test modules :)

declare function test:mkcol($root as xs:string, $path as xs:string) as empty() {
    test:mkcol-recursive($root, tokenize($path, "/"))
};

declare %private function test:mkcol-recursive($collection, $components) as empty() {
    if (exists($components)) then
        let $newColl := concat($collection, "/", $components[1])
        return (
            xmldb:create-collection($collection, $components[1])[2],
            test:mkcol-recursive($newColl, subsequence($components, 2))
        )
    else
        ()
};

declare function test:to-html($output as element(testsuites)) {
    <div class="testresult">
    {
        $output/testsuite !
            <section>
                <h2>{@package/string()}</h2>
                <table>
                {
                    for $case in testcase
                    return
                        test:print-testcase($case)
                }
                </table>
            </section>
    }
    </div>
};

declare %private function test:print-testcase($case as element(testcase)) {
    <tr class="{if ($case/failure) then 'fail' else 'pass'}">
        <td>{$case/@name/string()}</td>
        <td>
        {
            if ($case/failure) then
                ($case/failure/@message/string(), " Expected: ", $case/failure/text())
            else
                "OK"
        }
        </td>
    </tr>
};


ordered facets, better handling of overall counts, store result

xquery version "1.0";

    declare option exist:serialize "method=text media-type=text/csv encoding=UTF-8";

    let $rel-label := ' ppm'
    let $lb := "
"
    let $percentile-base := 1000000
    let $decimal-base := 100
    let $all-label := '_all_'
  (:    let $data := subsequence(collection("/db/apps/cr/modules/testing/results/corpus207-solr4-8985"),1,50)       :)
    let $data := collection("/db/apps/cr/modules/testing/results/corpus207-solr4-8985")

    let  $base-data := doc("/db/apps/cr/modules/testing/results/corpus207-solr4-8985/stats-overall-sum-base.xml")

    (: contains - to eliminate erroneously doubly assigned:  "amitte aost" "asuedost asuedost" :)
    let $ordered-base-data := for $val in $base-data//dataseries/value[not(@label=$all-label)][not(contains(@label,' '))]
                                  order by $val/ancestor::dataset/@name descending, xs:string($val/@label)
                                  return $val

    (: let $facet-labels := for $val in $base-data//dataseries/value[not(@label=$all-label)]  :)
    let $facet-labels := for $val in $ordered-base-data
                                (: order by $val/ancestor::dataset/@name descending, xs:string($val/@label) :)
                                return (concat($val/ancestor::dataset/@name, ':', xs:string($val/@label)), concat( xs:string($val/@label), $rel-label))

    let $all-records  := $base-data//result/xs:string(@numFound)
    let $all-value := ($base-data//dataseries/value[@label=$all-label])[1]

    let $base-values := for $val in $ordered-base-data
                                let $rel := round($val div $all-value * $percentile-base * $decimal-base) div $decimal-base
                            return ( xs:string($val/@formatted), translate(format-number($rel,'#,###.##'),',.','.,'))

    let $csv-header := string-join(('lemma', 'records', 'hits', 'freq', $facet-labels)  ,';')
    let $csv-baseline := string-join(('*.*', $all-records, translate($all-value,'.',','), $percentile-base,  $base-values  ),';')

    let $csv-data := for $result in $data//result[@type="multiresult"]
                    let $q := $result//lst[@name='params']/str[@name='qkey']/text(),
                        $numberOfRecords := $result//@numFound,
                        $numberOfHits-x := $result//@numHits,
                        $numberOfHits := if (number($numberOfHits-x)=number($numberOfHits-x)) then
                                         if ($numberOfHits-x > $numberOfRecords * 10) then '' else
                                                round($numberOfHits-x) else   $numberOfHits-x,
                        (: $freq :=round((if(number($numberOfHits)=number($numberOfHits)) then $numberOfHits else $numberOfRecords)
                                    div $all-value * $percentile-base * $decimal-base) div $decimal-base, :)
                        $freq := ($result//dataseries[not(@type='base')]/value[@label=$all-label]/xs:string(@rel_formatted))[1],
                        $values := for $val in $result//dataseries[not(@type='base')]/
                        value[not(@label=$all-label)][not(contains(@label,' '))]
                        order by $val/ancestor::dataset/@name descending, xs:string($val/@label)
                        return ( xs:string($val/@formatted), xs:string($val/@rel_formatted))
        return string-join(($q,$numberOfRecords, translate($numberOfHits,'.',','), translate($freq,'.',','),  $values),';')

    (:  for processing directly the solr-response
    let $csv := for $response in $data//response
        let $q := $response//lst[@name='params']/str[@name='q']/text(),
            $numberOfRecords := $response//result/xs:string(@numFound),
            $facets := $response//lst[@name='facet_fields']/lst/int,
            $region := for $m in $map return sum($facets[xs:string(@name)=$m/l/text()])
        return string-join(($q,$numberOfRecords, $region),';')
    :)

    let $csv := string-join(($csv-header, $csv-baseline, $csv-data), $lb)

    return xmldb:store("/db/apps/testing/","VWB-lemmas_onAMC_all.csv",$csv)

    xquery version "1.0";

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

    let $rel-label := ' ppm'
    let $percentile-base := 1000000
    let $decimal-base := 100
    let $all-label := '_all_'
    let $data := collection("/db/cr/modules/testing/results/local-solr4")

    let  $base-data := doc("/db/cr/modules/testing/results/local-solr4/stats-overall-sum-base.xml")

    let $facet-labels := for $val in $base-data//dataseries/value[not(@label=$all-label)]
                                order by $val/ancestor::dataset/@name descending, xs:string($val/@label)
                                return (concat($val/ancestor::dataset/@name, ':', xs:string($val/@label)), concat( xs:string($val/@label), $rel-label))

    let $all-records  := $base-data//result/xs:string(@numFound)
    let $all-value := ($base-data//dataseries/value[@label=$all-label])[1]

    let $base-values := for $val in $base-data//dataseries/value[not(@label=$all-label)]
                                let $rel := round($val div $all-value * $percentile-base * $decimal-base) div $decimal-base
                            order by $val/ancestor::dataset/@name descending, xs:string($val/@label)
                            return ( xs:string($val/@formatted), translate(format-number($rel,'#,###.##'),',.','.,'))

    let $csv-header := string-join(('lemma', 'records', 'hits',  $facet-labels)  ,';')
    let $csv-baseline := string-join(('*.*', $all-records, $all-value,   $base-values  ),';')

    let $csv := for $result in $data//result[@type="multiresult"]
                    let $q := $result//lst[@name='params']/str[@name='qkey']/text(),
                        $numberOfRecords := $result//xs:string(@numFound),
                        $numberOfHits := $result//xs:string(@numHits),
                        $values := for $val in $result//dataseries[not(@type='base')]/
                        value[not(@label=$all-label)]
                        order by $val/ancestor::dataset/@name descending, xs:string($val/@label)
                        return ( xs:string($val/@formatted), xs:string($val/@rel_formatted))
        return (string-join(($q,$numberOfRecords, $numberOfHits, $values),';'),"
")

    (:  for processing directly the solr-response
    let $csv := for $response in $data//response
        let $q := $response//lst[@name='params']/str[@name='q']/text(),
            $numberOfRecords := $response//result/xs:string(@numFound),
            $facets := $response//lst[@name='facet_fields']/lst/int,
            $region := for $m in $map return sum($facets[xs:string(@name)=$m/l/text()])
        return string-join(($q,$numberOfRecords, $region),';')
    :)

    return ($csv-header, "
", $csv-baseline, "
", $csv)


fixed descriptions to show node() instead of just text(); added contributions from Loren (Version, Since, See)

Port of rev10964

svn path=/stable/eXist-1.4.x/; revision=11678

xquery version "1.0";

(: $Id$ :)

(:~
    Main XQuery script for the RESTful function docs application.

    The parameters passed in from controller.xql are:
        basepath: Used as base path for URLs
        module:   Module name
        function: Function name

    The controller.xql intercepts URLs like
        http://exist-db.org/exist/functions/xmldb/login
    and parses and passes these parameters transparently to the script:
        basepath: /exist/functions/
        module:   xmldb
        function: login
:)

(: eXist module namespaces :)
declare namespace request="http://exist-db.org/xquery/request";
declare namespace text="http://exist-db.org/xquery/text";
declare namespace util="http://exist-db.org/xquery/util";

(: Document namespaces :)
declare namespace xq="http://www.xqdoc.org/1.0";

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

(: App root URL, passed in from controller.xql.  Used as base path for URLs. :)
declare variable $basepath := request:get-parameter('basepath', ());

(: Render a function or a set of functions :)
declare function local:render-function( $functionNode as element(xq:function)+, $showlinks as xs:boolean) as element() {
    let $parentModule := $functionNode/ancestor::xq:xqdoc/xq:module/xq:uri/text()
    let $parentModuleName := $functionNode/ancestor::xq:xqdoc/xq:module/xq:name/text()
    let $functionName := $functionNode/xq:name/text()
    let $functionSignature := $functionNode/xq:signature/text()
    let $functionDeprecated := $functionNode/xq:comment/xq:deprecated/text()
    let $functionDescription := $functionNode/xq:comment/xq:description/text()
    let $functionParagraphs := tokenize($functionDescription, "\n")
    let $functionVersion := $functionNode/xq:comment/xq:version/text()
    let $functionParameters := $functionNode/xq:comment/xq:param
    let $functionSees := $functionNode/xq:comment/xq:see
    let $functionReturns := $functionNode/xq:comment/xq:return/text()
    let $authors := $functionNode/xq:comment/xq:author
    let $sinces := $functionNode/xq:comment/xq:since
    return

{
                if ($showlinks) then
                    {$functionName}
                else $functionName
            }

{
                if (not(starts-with($functionSignature, $parentModuleName))) then
                    concat($parentModuleName, ':', $functionSignature)
                else
                    $functionSignature
            }

{
                for $desc in $functionParagraphs
                return

{$desc}

            }

{
                for $author in $authors
                return
                    {$author}
            }

            {
            if (string-length($functionVersion) > 0) then

Version {$functionVersion}

            else ()
            }

{
                if (empty($sinces)) then ()
                else

Since {string-join($sinces, ", ")}

            }

{
                for $see in $functionSees
                return

See {$see}

            }

{
                    for $parameter in $functionParameters
                    let $split := text:groups(normalize-space($parameter), "^(\$[^ ]+) (.*)$")
                    return

                            {$split[2]}
                            {$split[3]}

                }

            {
            if (string-length($functionReturns) > 0) then

Returns {$functionReturns}

            else (),
            if (string-length($functionDeprecated) > 0) then

Deprecated: {$functionDeprecated}

            else ()
            }

};

(: Render a module or set of modules :)
(: TODO add moduleSees, other standard XQDoc comments :)
declare function local:render-module($moduleURIs as xs:string+, $functionName as xs:string?, $showlinks as xs:boolean) as element()+ {
    for $moduleURI in $moduleURIs
	let $moduleDocs := /xq:xqdoc[xq:module/xq:uri eq $moduleURI]
	let $moduleName := if ($moduleURI = 'http://www.w3.org/2005/xpath-functions') then 'fn' else $moduleDocs/xq:module/xq:name/text()
	let $moduleDescription := $moduleDocs/xq:module/xq:comment/xq:description/node()
	order by $moduleURI
	return

{
                  if ($showlinks) then
                     {$moduleName}
                  else
                     $moduleName
               }

{$moduleURI}

{$moduleDescription}

{
	           (: Decide whether to render a single function or to render them all :)
	           if ($functionName) then
	               for $functionNode in $moduleDocs/xq:functions/xq:function[xq:name eq $functionName]
                   return local:render-function($functionNode, $showlinks)
               else
    	           for $functionNode in $moduleDocs/xq:functions/xq:function
    	           return local:render-function($functionNode, $showlinks)
	       }

};

(:
 : URL handling functions
 :)

(: Constructs a URL from a module URI :)
declare function local:moduleURI-to-URL($moduleURI as xs:string) as xs:string {
    if ($moduleURI = 'http://www.w3.org/2005/xpath-functions') then
        concat($basepath, 'fn')
    else
        concat($basepath, /xq:xqdoc/xq:module[xq:uri eq $moduleURI]/xq:name/text())
};

(: Constructs a URL from a module :)
declare function local:module-to-URL($module as xs:string) as xs:string {
    concat($basepath, $module)
};

(: Constructs a URL from a function :)
declare function local:function-to-URL($moduleURI as xs:string, $function as xs:string) {
    concat(local:moduleURI-to-URL($moduleURI), '/', $function)
};

(: Derives the module name from the module URI :)
declare function local:moduleURI-to-module($moduleURI as xs:string) as xs:string {
    if ($moduleURI = 'http://www.w3.org/2005/xpath-functions') then
        'fn'
    else
        /xq:xqdoc/xq:module[xq:uri eq $moduleURI]/xq:name/text()
};

(: Lists all modules :)
declare function local:list-modules($moduleURIs) {
    (

Reload documentation
        (click here if you enabled/disabled additional modules)

    ,

(eXist version: {util:system-property("product-version")},
        build: {util:system-property("product-build")}, functions: {count(//xq:function)}.)
        Modules have to be enabled in conf.xml to appear here.

    ,

Expand All or select a single module:

    ,

Name	Description	Namespace URI

{
            for $moduleURI in $moduleURIs
            let $moduleDocs := /xq:xqdoc[xq:module/xq:uri eq $moduleURI]
        	let $moduleName :=
        	   if ($moduleURI eq 'http://www.w3.org/2005/xpath-functions') then
        	       (: note: the xq:name for the xpath functions module is empty
        	        : since it's the default function namespace, but we need a name
        	        : for the link, so we just use 'fn' :)
        	       'fn'
               else $moduleDocs/xq:module/xq:name/text()
        	let $moduleDescription := $moduleDocs/xq:module/xq:comment/xq:description/node()
        	order by $moduleURI
            return

                    {$moduleName}
                    {$moduleDescription}
                    {$moduleURI}

        }

    )
};

(: Breadcrumbs for the page :)
declare function local:breadcrumbs($module, $function, $viewall) {

        Modules
        {
        if ($viewall) then
            ' > All Modules and Functions'
        else if ($module and not($function)) then
            (
            ' > '
            ,
            {$module}
            )
        else if ($module and $function) then
            (
            ' > '
            ,
            {$module}
            ,
            ' > '
            ,
            {$function}
            )
        else
            ' > Home'
        }

};

(: Footer-like 'return to home' link :)
declare function local:return-to-main() as element() {

        Return to list of all modules

};

(: Business logic :)
declare function local:main() {
    (: Get URL parameters :)
    let $module := request:get-parameter('module', ())
    let $function := request:get-parameter('function', ())
    let $showlinks := request:get-parameter('showlinks', 1) cast as xs:boolean
    let $q := request:get-parameter('q', ())

    (: Catch a request for 'all', i.e. the complete listing :)
    let $viewall := $module eq 'all'

    (: Derive module URIs based on URL parameter $module :)
    let $allModuleURIs := /xq:xqdoc/xq:module/xq:uri
    let $matchingModuleURIs := if ($module) then
        if ($module = 'fn') then
            'http://www.w3.org/2005/xpath-functions'
        else
            $allModuleURIs[following-sibling::xq:name eq $module]
        else ()
    let $moduleURIs := if ($matchingModuleURIs) then $matchingModuleURIs else $allModuleURIs

    return
        (
        (: Show documentation for all modules:)
        if ($viewall) then
            (
            local:breadcrumbs($module, $function, $viewall)
            ,
            local:render-module($moduleURIs, (), $showlinks)
            ,
            local:return-to-main()
            )
        (: Show just the list of modules :)
        else if (not($module)) then
            (
            local:breadcrumbs($module, $function, $viewall)
            ,
            local:list-modules($moduleURIs)
            )
        (: Show a single module :)
        else if ($module and $matchingModuleURIs) then
            if (count($matchingModuleURIs) gt 1) then
                (: TODO: Add handling for resolving modules with the same 'name' :)
                (
                local:breadcrumbs($module, $function, $viewall)
                ,
                local:render-module($moduleURIs, $function, $showlinks)
                ,
                local:return-to-main()
                )
            else
                (
                local:breadcrumbs($module, $function, $viewall)
                ,
                local:render-module($moduleURIs, $function, $showlinks)
                ,
                local:return-to-main()
                )
        (: Handle cases where there are no exact matching modules :)
        else
            (: else if ($module and not($matchingModules)) :)
            (: TODO add a fuzzy search :)
            (
            local:breadcrumbs((), (), $viewall)
            ,

Sorry, there are no modules that match "{$module}."  Please choose from the list below:

            ,
            local:list-modules($moduleURIs)
            )
        )

};

(: Module body :)
<book>
    <bookinfo>
        <graphic fileref="logo.jpg"/>
        <productname>Open Source Native XML Database</productname>
        <title>eXist Function Modules</title>
        <link rel="shortcut icon" href="../resources/exist_icon_16x16.ico"/>
		<link rel="icon" href="../resources/exist_icon_16x16.png" type="image/png"/>

    </bookinfo>

        <xi:include xmlns:xi="http://www.w3.org/2001/XInclude" href="../sidebar.xml"/>

    <chapter>
        <title>A RESTful browser for eXist Function Modules</title>
        { local:main() }
    </chapter>
</book>

xquery version "1.0";

(: $Id$ :)

(:~
    Main XQuery script for the RESTful function docs application.

    The parameters passed in from controller.xql are:
        basepath: Used as base path for URLs
        module:   Module name
        function: Function name

    The controller.xql intercepts URLs like
        http://exist-db.org/exist/functions/xmldb/login
    and parses and passes these parameters transparently to the script:
        basepath: /exist/functions/
        module:   xmldb
        function: login
:)

(: eXist module namespaces :)
declare namespace request="http://exist-db.org/xquery/request";
declare namespace text="http://exist-db.org/xquery/text";
declare namespace util="http://exist-db.org/xquery/util";

(: Document namespaces :)
declare namespace xq="http://www.xqdoc.org/1.0";

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

(: App root URL, passed in from controller.xql.  Used as base path for URLs. :)
declare variable $basepath := request:get-parameter('basepath', ());

(: Render a function or a set of functions :)
declare function local:render-function( $functionNode as element(xq:function)+, $showlinks as xs:boolean) as element() {
    let $parentModule := $functionNode/ancestor::xq:xqdoc/xq:module/xq:uri/text()
    let $parentModuleName := $functionNode/ancestor::xq:xqdoc/xq:module/xq:name/text()
    let $functionName := $functionNode/xq:name/text()
    let $functionSignature := $functionNode/xq:signature/text()
    let $functionDeprecated := $functionNode/xq:comment/xq:deprecated/text()
    let $functionDescription := $functionNode/xq:comment/xq:description/text()
    let $functionParagraphs := tokenize($functionDescription, "\n")
    let $functionVersion := $functionNode/xq:comment/xq:version
    let $functionParameters := $functionNode/xq:comment/xq:param
    let $functionReturns := $functionNode/xq:comment/xq:return/text()
    let $authors := $functionNode/xq:comment/xq:author
    let $sinces := $functionNode/xq:comment/xq:since
    return

{
                if ($showlinks) then
                    {$functionName}
                else $functionName
            }

{if (not(starts-with($functionSignature, $parentModuleName))) then concat($parentModuleName, ':', $functionSignature) else $functionSignature}

{
                for $desc in $functionParagraphs
                return

{$desc}

            }

{
                for $author in $authors
                return
                    {$author}
            }

{$functionVersion}

{
                for $since in $sinces
                return
                    {$since}
            }

{
                    for $parameter in $functionParameters
                    let $split := text:groups($parameter, "^(\$[^ ]+) (.*)$")
                    return

                            {$split[2]}
                            {$split[3]}

                }

            {
            if (string-length($functionReturns) > 0)
            then

Returns {$functionReturns}

            else (),
            if (string-length($functionDeprecated) > 0)
            then

Deprecated: {$functionDeprecated}

            else ()
            }

};

(: Render a module or set of modules :)
declare function local:render-module($moduleURIs as xs:string+, $functionName as xs:string?, $showlinks as xs:boolean) as element()+ {
    for $moduleURI in $moduleURIs
	let $moduleDocs := /xq:xqdoc[xq:module/xq:uri eq $moduleURI]
	let $moduleName := if ($moduleURI = 'http://www.w3.org/2005/xpath-functions') then 'fn' else $moduleDocs/xq:module/xq:name/text()
	let $moduleDescription := $moduleDocs/xq:module/xq:comment/xq:description/text()
	order by $moduleURI
	return

{
                  if ($showlinks) then
                     {$moduleName}
                  else
                     $moduleName
               }

{$moduleURI}

{$moduleDescription}

{
	           (: Decide whether to render a single function or to render them all :)
	           if ($functionName) then
	               for $functionNode in $moduleDocs/xq:functions/xq:function[xq:name eq $functionName]
                   return local:render-function($functionNode, $showlinks)
               else
    	           for $functionNode in $moduleDocs/xq:functions/xq:function
    	           return local:render-function($functionNode, $showlinks)
	       }

};

(:
 : URL handling functions
 :)

(: Constructs a URL from a module URI :)
declare function local:moduleURI-to-URL($moduleURI as xs:string) as xs:string {
    if ($moduleURI = 'http://www.w3.org/2005/xpath-functions') then
        concat($basepath, 'fn')
    else
        concat($basepath, /xq:xqdoc/xq:module[xq:uri eq $moduleURI]/xq:name/text())
};

(: Constructs a URL from a module :)
declare function local:module-to-URL($module as xs:string) as xs:string {
    concat($basepath, $module)
};

(: Constructs a URL from a function :)
declare function local:function-to-URL($moduleURI as xs:string, $function as xs:string) {
    concat(local:moduleURI-to-URL($moduleURI), '/', $function)
};

(: Derives the module name from the module URI :)
declare function local:moduleURI-to-module($moduleURI as xs:string) as xs:string {
    if ($moduleURI = 'http://www.w3.org/2005/xpath-functions') then
        'fn'
    else
        /xq:xqdoc/xq:module[xq:uri eq $moduleURI]/xq:name/text()
};

(: Lists all modules :)
declare function local:list-modules($moduleURIs) {
    (

Reload documentation
        (click here if you enabled/disabled additional modules)

    ,

(eXist version: {util:system-property("product-version")},
        build: {util:system-property("product-build")}, functions: {count(//xq:function)}.)
        Modules have to be enabled in conf.xml to appear here.

    ,

Expand All or select a single module:

    ,

Name	Description	Namespace URI

{
            for $moduleURI in $moduleURIs
            let $moduleDocs := /xq:xqdoc[xq:module/xq:uri eq $moduleURI]
        	let $moduleName :=
        	   if ($moduleURI eq 'http://www.w3.org/2005/xpath-functions') then
        	       (: note: the xq:name for the xpath functions module is empty
        	        : since it's the default function namespace, but we need a name
        	        : for the link, so we just use 'fn' :)
        	       'fn'
               else $moduleDocs/xq:module/xq:name/text()
        	let $moduleDescription := $moduleDocs/xq:module/xq:comment/xq:description/text()
        	order by $moduleURI
            return

                    {$moduleName}
                    {$moduleDescription}
                    {$moduleURI}

        }

    )
};

(: Breadcrumbs for the page :)
declare function local:breadcrumbs($module, $function, $viewall) {

        Modules
        {
        if ($viewall) then
            ' > All Modules and Functions'
        else if ($module and not($function)) then
            (
            ' > '
            ,
            {$module}
            )
        else if ($module and $function) then
            (
            ' > '
            ,
            {$module}
            ,
            ' > '
            ,
            {$function}
            )
        else
            ' > Home'
        }

};

(: Footer-like 'return to home' link :)
declare function local:return-to-main() as element() {

        Return to list of all modules

};

(: Business logic :)
declare function local:main() {
    (: Get URL parameters :)
    let $module := request:get-parameter('module', ())
    let $function := request:get-parameter('function', ())
    let $showlinks := request:get-parameter('showlinks', 1) cast as xs:boolean
    let $q := request:get-parameter('q', ())

    (: Catch a request for 'all', i.e. the complete listing :)
    let $viewall := $module eq 'all'

    (: Derive module URIs based on URL parameter $module :)
    let $allModuleURIs := /xq:xqdoc/xq:module/xq:uri
    let $matchingModuleURIs := if ($module) then
        if ($module = 'fn') then
            'http://www.w3.org/2005/xpath-functions'
        else
            $allModuleURIs[following-sibling::xq:name eq $module]
        else ()
    let $moduleURIs := if ($matchingModuleURIs) then $matchingModuleURIs else $allModuleURIs

    return
        (
        (: Show documentation for all modules:)
        if ($viewall) then
            (
            local:breadcrumbs($module, $function, $viewall)
            ,
            local:render-module($moduleURIs, (), $showlinks)
            ,
            local:return-to-main()
            )
        (: Show just the list of modules :)
        else if (not($module)) then
            (
            local:breadcrumbs($module, $function, $viewall)
            ,
            local:list-modules($moduleURIs)
            )
        (: Show a single module :)
        else if ($module and $matchingModuleURIs) then
            if (count($matchingModuleURIs) gt 1) then
                (: TODO: Add handling for resolving modules with the same 'name' :)
                (
                local:breadcrumbs($module, $function, $viewall)
                ,
                local:render-module($moduleURIs, $function, $showlinks)
                ,
                local:return-to-main()
                )
            else
                (
                local:breadcrumbs($module, $function, $viewall)
                ,
                local:render-module($moduleURIs, $function, $showlinks)
                ,
                local:return-to-main()
                )
        (: Handle cases where there are no exact matching modules :)
        else
            (: else if ($module and not($matchingModules)) :)
            (: TODO add a fuzzy search :)
            (
            local:breadcrumbs((), (), $viewall)
            ,

Sorry, there are no modules that match "{$module}."  Please choose from the list below:

            ,
            local:list-modules($moduleURIs)
            )
        )

};

(: Module body :)
<book>
    <bookinfo>
        <graphic fileref="logo.jpg"/>
        <productname>Open Source Native XML Database</productname>
        <title>eXist Function Modules</title>
        <link rel="shortcut icon" href="../resources/exist_icon_16x16.ico"/>
		<link rel="icon" href="../resources/exist_icon_16x16.png" type="image/png"/>

    </bookinfo>

        <xi:include xmlns:xi="http://www.w3.org/2001/XInclude" href="../sidebar.xml"/>

    <chapter>
        <title>A RESTful browser for eXist Function Modules</title>
        { local:main() }
    </chapter>
</book>