Added support for %test:pending("a message describing the TODO")

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 namespace stats="http://exist-db.org/xquery/profiling";

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($functions, function($func) {
                    namespace-uri-from-QName(function-name($func)) = $module
                })
            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)}" pending="{count($results/skipped)}"
                            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)) {
    if($meta/annotation[ends-with(@name,  ":pending")])then
      test:print-result($meta, (), <report>{
        element pending {
          $meta/annotation[ends-with(@name,  ":pending")]/value ! text()
        }
      }</report>)
    else
      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
            ()
};

declare function test:enable-tracing($meta as element(function)) {
    let $statsAnno := $meta//annotation[contains(@name, ":stats")]
    return
        if (exists($statsAnno)) then (
            system:clear-trace(),
            system:enable-tracing(true(), false()),
            true()
        ) else
            false()
};

(:~
 : 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 $trace := test:enable-tracing($meta)
    let $userAnno := $meta/annotation[contains(@name, ":user")]
    let $result :=
        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)
    return
        if ($trace) then
            (: Get trace output and filter out stats :)
            let $traceOutput :=
                (system:trace(), system:clear-trace(), system:enable-tracing(false()))
            return
                element { node-name($traceOutput) } {
                    $traceOutput/stats:*[not(starts-with(@source, "org.exist") or contains(@source, "xqsuite.xql"))]
                }
        else
            $result
};

(:~
 : 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 $prolog :=
        if ($result instance of element()*) then
            let $namespaces := fold-left($result/descendant-or-self::*, map:new(),
                function ($namespaces as map(*), $xml as element()) {
                    map:new(($namespaces,
                	    for $prefix in in-scope-prefixes($xml)
                	    where $prefix != "" and $prefix != "xml"
                	    return
                	        map:entry($prefix, namespace-uri-for-prefix($prefix, $xml))
                    ))
                }
            )
            return
                string-join(
                    for $prefix in map:keys($namespaces)
                    return
                        "declare namespace " || $prefix || "='" || $namespaces($prefix) || "';",
                    " "
                )
        else
            ()
    let $xr :=
        test:checkXPathResult(
            if (matches($expr, "^\s*/")) then
                util:eval($prolog || "$result" || $expr)
            else
                util:eval($prolog || $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 or $case/error) then 'fail' else 'pass'}">
        <td>{$case/@name/string()}</td>
        <td>
        {
            if ($case/failure) then
                ($case/failure/@message/string(), " Expected: ", $case/failure/text())
            else if ($case/error) then
                ($case/error/@type/string(), " ", $case/error/@message/string())
            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 namespace stats="http://exist-db.org/xquery/profiling";

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($functions, function($func) {
                    namespace-uri-from-QName(function-name($func)) = $module
                })
            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
            ()
};

declare function test:enable-tracing($meta as element(function)) {
    let $statsAnno := $meta//annotation[contains(@name, ":stats")]
    return
        if (exists($statsAnno)) then (
            system:clear-trace(),
            system:enable-tracing(true(), false()),
            true()
        ) else
            false()
};

(:~
 : 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 $trace := test:enable-tracing($meta)
    let $userAnno := $meta/annotation[contains(@name, ":user")]
    let $result :=
        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)
    return
        if ($trace) then
            (: Get trace output and filter out stats :)
            let $traceOutput :=
                (system:trace(), system:clear-trace(), system:enable-tracing(false()))
            return
                element { node-name($traceOutput) } {
                    $traceOutput/stats:*[not(starts-with(@source, "org.exist") or contains(@source, "xqsuite.xql"))]
                }
        else
            $result
};

(:~
 : 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 $prolog :=
        if ($result instance of element()*) then
            let $namespaces := fold-left($result/descendant-or-self::*, map:new(),
                function ($namespaces as map(*), $xml as element()) {
                    map:new(($namespaces,
                	    for $prefix in in-scope-prefixes($xml)
                	    where $prefix != "" and $prefix != "xml"
                	    return
                	        map:entry($prefix, namespace-uri-for-prefix($prefix, $xml))
                    ))
                }
            )
            return
                string-join(
                    for $prefix in map:keys($namespaces)
                    return
                        "declare namespace " || $prefix || "='" || $namespaces($prefix) || "';",
                    " "
                )
        else
            ()
    let $xr :=
        test:checkXPathResult(
            if (matches($expr, "^\s*/")) then
                util:eval($prolog || "$result" || $expr)
            else
                util:eval($prolog || $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 or $case/error) then 'fail' else 'pass'}">
        <td>{$case/@name/string()}</td>
        <td>
        {
            if ($case/failure) then
                ($case/failure/@message/string(), " Expected: ", $case/failure/text())
            else if ($case/error) then
                ($case/error/@type/string(), " ", $case/error/@message/string())
            else
                "OK"
        }
        </td>
    </tr>
};


fixes

fixes

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

xquery version "1.0";
(: $Id$ :)
(:
    Module: examples setup
:)

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

declare namespace xdb="http://exist-db.org/xquery/xmldb";
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 system="http://exist-db.org/xquery/system";

declare function setup:main() as element()
{

Examples Setup

        {
            let $action := request:get-parameter("action", ()) return
                if($action) then
                (
                    if($action eq "Import Example Data") then
                    (
                        setup:importLocal()
                    )
                    else if($action eq "Import Remote Files") then
                    (
                        setup:importFromURLs()
                    )
                    else
                    (
                        setup:page3()
                    )
                )
                else
                (
                    setup:page1()
                )
        }

};

declare function setup:importLocal() as element()+
{
    let $home := system:get-exist-home(),
    $pathSep := util:system-property("file.separator"),
    $dir := if (doc-available(concat("file:///", $home, "/exist-samples/examples.xml"))) then
        (
            concat($home, $pathSep, "exist-samples")
        )
        else if(ends-with($home, "WEB-INF")) then
        (
            concat(substring-before($home, "WEB-INF"), "samples")
        )
        else
        (
            concat($home, $pathSep, "samples")
        )
    return (
        setup:page2(),

Loading from directory: {$dir}.

Actions:

            {
                setup:create-collection("/db", "shakespeare"),
                setup:create-collection("/db/shakespeare", "plays"),
                setup:store-files("/db/shakespeare/plays", $dir,  "shakespeare/*.xml", "text/xml"),
                setup:store-files("/db/shakespeare/plays", $dir, "shakespeare/*.xsl", "text/xml"),
                setup:store-files("/db/shakespeare/plays", $dir, "shakespeare/*.css", "text/css"),
                setup:create-collection("/db", "xinclude"),
                setup:store-files("/db/xinclude", $dir, "xinclude/*.xsl", "text/xml"),
                setup:store-files("/db/xinclude", $dir, "xinclude/*.xml", "text/xml"),
                setup:store-files("/db/xinclude", $dir, "xinclude/*.xq", "application/xquery"),
                setup:store-files("/db/xinclude", $dir, "xinclude/*.jpg", "image/jpeg"),
                setup:store-files("/db/xinclude", $dir, "xinclude/*.css", "text/css"),
                setup:create-collection("/db", "library"),
                setup:store-files("/db/library", $dir, "*.rdf", "text/xml"),
                setup:create-collection("/db", "mods"),
                setup:store-files("/db/mods", $dir, "mods/*.xml", "text/xml"),
                setup:store-files("/db", $dir, "*.xml", "text/xml"),
                setup:create-collection("/db/system/config", "db"),
                setup:create-collection("/db/system/config/db", "mondial"),
                setup:store-files("/db/system/config/db/mondial", $dir, "mondial.xconf", "text/xml")
            }

    )
};

declare function setup:importFromURLs() as element()+
{
    (
        setup:page3(),

Actions:

            {
                let $includeXmlad := request:get-parameter("xmlad", ()),
                $includeMondial := request:get-parameter("mondial", ()) return
                (
                    if($includeXmlad) then
                    (
                        setup:create-collection("/db", "xmlad"),
                        setup:load-URL("/db/xmlad", "http://surfnet.dl.sourceforge.net/sourceforge/xmlad/xmlad.xml", "xmlad.xml")
                    )else (),
                    if($includeMondial) then
                    (
                        setup:create-collection("/db", "mondial"),
                        setup:load-URL("/db/mondial", "http://www.dbis.informatik.uni-goettingen.de/Mondial/mondial-europe.xml", "mondial.xml")
                    )else ()
                )
            }

    )
};

declare function setup:load-URL($collection as xs:string, $url as xs:anyURI, $docName as xs:string) as element()
{
    let $x := xdb:store($collection, $docName, $url) return

File {$docName} imported from url: {$url}

};

declare function setup:store-files($collection as xs:string, $home as xs:string, $patterns as xs:string, $mimeType as xs:string) as element()*
{
    let $stored := xdb:store-files-from-pattern($collection, $home, $patterns, $mimeType)
    for $doc in $stored return

Uploaded: {$doc}

};

declare function setup:create-collection($parent as xs:string, $name as xs:string) as element()
{
    let $col := xdb:create-collection($parent, $name) return

Created collection: {$col}

};

declare function setup:page1() as element()
{
    <form action="{session:encode-url(request:get-uri())}" method="post">

eXist ships with a number of XQuery examples. Some of these
        require certain documents to be stored in the database. Clicking on the button
        below will import the required data from the samples directory:

        <input type="submit" name="action" value="Import Example Data"/>
        <input type="hidden" name="panel" value="setup"/>
    </form>
};

declare function setup:page2() as element()
{
    <form action="{session:encode-url(request:get-uri())}" method="post">

The XQuery examples also use some XML data not included with the distribution.
        I can try to download the corresponding data. Do you want me to do so?

        <input type="checkbox" name="xmlad" checked="true"/>
        The XML Acronym Demystifier
        (approx. 384K)

        <input type="checkbox" name="mondial"/>
        The Mondial Database (Europe)
        (approx. 410K)

<input type="submit" name="action" value="Import Remote Files"/>
        <input type="submit" name="action" value="Skip"/>

        <input type="hidden" name="panel" value="setup"/>
    </form>
};

declare function setup:page3() as element()
{

Files have been loaded. You can now go to the
    examples page.

};

xquery version "1.0";
(: $Id$ :)
(:
    Module: examples setup
:)

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

declare namespace xdb="http://exist-db.org/xquery/xmldb";
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 system="http://exist-db.org/xquery/system";

declare function setup:main() as element()
{

Examples Setup

        {
            let $action := request:get-parameter("action", ()) return
                if($action) then
                (
                    if($action eq "Import Example Data") then
                    (
                        setup:importLocal()
                    )
                    else if($action eq "Import Remote Files") then
                    (
                        setup:importFromURLs()
                    )
                    else
                    (
                        setup:page3()
                    )
                )
                else
                (
                    setup:page1()
                )
        }

};

declare function setup:importLocal() as element()+
{
    let $home := system:get-exist-home(),
    $pathSep := util:system-property("file.separator"),
    $dir := if (doc-available(concat("file:///", $home, "/exist-samples/examples.xml"))) then
        (
            concat($home, $pathSep, "exist-samples")
        )
        else if(ends-with($home, "WEB-INF")) then
        (
            concat(substring-before($home, "WEB-INF"), "samples")
        )
        else
        (
            concat($home, $pathSep, "samples")
        )
    return (
        setup:page2(),

Loading from directory: {$dir}.

Actions:

            {
                setup:create-collection("/db", "shakespeare"),
                setup:create-collection("/db/shakespeare", "plays"),
                setup:store-files("/db/shakespeare/plays", $dir,  "shakespeare/*.xml",, "text/xml"),
                setup:store-files("/db/shakespeare/plays", $dir, "shakespeare/*.xsl", "text/xml"),
                setup:store-files("/db/shakespeare/plays", $dir, "shakespeare/*.css", "text/css"),
                setup:create-collection("/db", "xinclude"),
                setup:store-files("/db/xinclude", $dir, ( "xinclude/*.xsl", "xinclude/*.xml"), "text/xml"),
                setup:store-files("/db/xinclude", $dir, "xinclude/*.xq", "application/xquery"),
                setup:store-files("/db/xinclude", $dir, "xinclude/*.jpg", "image/jpeg"),
                setup:store-files("/db/xinclude", $dir, "xinclude/*.css", "text/css"),
                setup:create-collection("/db", "library"),
                setup:store-files("/db/library", $dir, "*.rdf", "text/xml"),
                setup:create-collection("/db", "mods"),
                setup:store-files("/db/mods", $dir, "mods/*.xml", "text/xml"),
                setup:store-files("/db", $dir, "*.xml", "text/xml"),
                setup:create-collection("/db/system/config", "db"),
                setup:create-collection("/db/system/config/db", "mondial"),
                setup:store-files("/db/system/config/db/mondial", $dir, "mondial.xconf", "text/xml")
            }

    )
};

declare function setup:importFromURLs() as element()+
{
    (
        setup:page3(),

Actions:

            {
                let $includeXmlad := request:get-parameter("xmlad", ()),
                $includeMondial := request:get-parameter("mondial", ()) return
                (
                    if($includeXmlad) then
                    (
                        setup:create-collection("/db", "xmlad"),
                        setup:load-URL("/db/xmlad", "http://surfnet.dl.sourceforge.net/sourceforge/xmlad/xmlad.xml", "xmlad.xml")
                    )else (),
                    if($includeMondial) then
                    (
                        setup:create-collection("/db", "mondial"),
                        setup:load-URL("/db/mondial", "http://www.dbis.informatik.uni-goettingen.de/Mondial/mondial-europe.xml", "mondial.xml")
                    )else ()
                )
            }

    )
};

declare function setup:load-URL($collection as xs:string, $url as xs:anyURI, $docName as xs:string) as element()
{
    let $x := xdb:store($collection, $docName, $url) return

File {$docName} imported from url: {$url}

};

declare function setup:store-files($collection as xs:string, $home as xs:string, $patterns as xs:string, $mimeType as xs:string) as element()*
{
    let $stored := xdb:store-files-from-pattern($collection, $home, $patterns, $mimeType)
    for $doc in $stored return

Uploaded: {$doc}

};

declare function setup:create-collection($parent as xs:string, $name as xs:string) as element()
{
    let $col := xdb:create-collection($parent, $name) return

Created collection: {$col}

};

declare function setup:page1() as element()
{
    <form action="{session:encode-url(request:get-uri())}" method="post">

eXist ships with a number of XQuery examples. Some of these
        require certain documents to be stored in the database. Clicking on the button
        below will import the required data from the samples directory:

        <input type="submit" name="action" value="Import Example Data"/>
        <input type="hidden" name="panel" value="setup"/>
    </form>
};

declare function setup:page2() as element()
{
    <form action="{session:encode-url(request:get-uri())}" method="post">

The XQuery examples also use some XML data not included with the distribution.
        I can try to download the corresponding data. Do you want me to do so?

        <input type="checkbox" name="xmlad" checked="true"/>
        The XML Acronym Demystifier
        (approx. 384K)

        <input type="checkbox" name="mondial"/>
        The Mondial Database (Europe)
        (approx. 410K)

<input type="submit" name="action" value="Import Remote Files"/>
        <input type="submit" name="action" value="Skip"/>

        <input type="hidden" name="panel" value="setup"/>
    </form>
};

declare function setup:page3() as element()
{

Files have been loaded. You can now go to the
    examples page.

};


Updated to conform with latest XQDoc code in rev10663, focused on searching XQDocs already extracted into the db in order to be able to search XQuery-based modules, not just the Java-based modules.  Note: XQuery-based modules distributed with eXist should be reviewed for adherence to XQDoc conventions.

Port of rev10670

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

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>

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:uri/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
            }

{$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 := util:extract-docs($moduleURI)
	let $moduleName := $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 {
    concat($basepath, tokenize($moduleURI, '/')[last()])
};

(: Constructs a URL from a module :)
declare function local:module-to-URL($module as xs:string) as xs:string {
    let $moduleURI := local:module-to-moduleURI($module)
    return local:moduleURI-to-URL($moduleURI)
};

(: 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 a module URI from a shorthand :)
declare function local:module-to-moduleURI($module as xs:string) as xs:string {
    util:registered-modules()[ends-with(., $module)]
};

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

(eXist version: {util:system-property("product-version")},
    build: {util:system-property("product-build")}.) 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 := util:extract-docs($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'
        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 proper module URIs :)
    let $allModules := util:registered-modules()
    let $matchingModules := if ($module) then $allModules[ends-with(., $module)] else ()
    let $moduleURIs := if ($matchingModules) then $matchingModules else $allModules

    return
        (
        (: Show verbose module documentation :)
        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 $matchingModules) then
            (
            local:breadcrumbs($module, $function, $viewall)
            ,
            local:render-module($moduleURIs, $function, $showlinks)
            ,
            local:return-to-main()
            )
        (: Show error, since there was no matching module :)
        else
            (: else if ($module and not($matchingModules)) :)
            (
            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 Java-Based 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 Java-Based Function Modules</title>
        { local:main() }
    </chapter>
</book>


Use lowercase 'marklogic' in the since annotations, to match the conformance name.

xquery version "1.0-ml";

(:~
 : MarkLogic map functions
 :
 : @see https://docs.marklogic.com/6.0/map
 :)
module  namespace map = "http://marklogic.com/xdmp/map";
declare namespace xs  = "http://www.w3.org/2001/XMLSchema";
declare namespace a   = "http://reecedunn.co.uk/xquery/annotations";

declare %a:since("marklogic", "6.0") function map:clear($map as map:map) as empty-sequence() external;
declare %a:since("marklogic", "6.0") function map:contains($map as map:map, $key as xs:string) as xs:boolean external;
declare %a:since("marklogic", "6.0") function map:count($map as map:map) as xs:unsignedInt external;
declare %a:since("marklogic", "6.0") function map:delete($map as map:map, $key as xs:string) as empty-sequence() external;
declare %a:since("marklogic", "7.0") function map:entry($key as xs:string, $value as item()*) as map:map external;
declare %a:since("marklogic", "6.0") function map:get($map as map:map, $key as xs:string) as item()* external;
declare %a:since("marklogic", "6.0") function map:keys($map as map:map) as xs:string* external;
declare %a:since("marklogic", "6.0") function map:map() as map:map external;
declare %a:since("marklogic", "6.0") function map:map($map as element(map:map)) as map:map external;
declare %a:since("marklogic", "7.0") function map:new() as map:map external;
declare %a:since("marklogic", "7.0") function map:new($map as element(map:map)) as map:map external;
declare %a:since("marklogic", "6.0") function map:put($map as map:map, $key as xs:string, $value as item()*) as empty-sequence() external;
declare %a:since("marklogic", "9.0") function map:set-javascript-by-ref($map as map:map, $key as xs:boolean) as empty-sequence() external;
declare %a:since("marklogic", "9.0") function map:with($map as map:map, $key as xs:string, $value as item()*) as map:map external;

xquery version "1.0-ml";

(:~
 : MarkLogic map functions
 :
 : @see https://docs.marklogic.com/6.0/map
 :)
module  namespace map = "http://marklogic.com/xdmp/map";
declare namespace xs  = "http://www.w3.org/2001/XMLSchema";
declare namespace a   = "http://reecedunn.co.uk/xquery/annotations";

declare %a:since("MarkLogic", "6.0") function map:clear($map as map:map) as empty-sequence() external;
declare %a:since("MarkLogic", "6.0") function map:contains($map as map:map, $key as xs:string) as xs:boolean external;
declare %a:since("MarkLogic", "6.0") function map:count($map as map:map) as xs:unsignedInt external;
declare %a:since("MarkLogic", "6.0") function map:delete($map as map:map, $key as xs:string) as empty-sequence() external;
declare %a:since("MarkLogic", "7.0") function map:entry($key as xs:string, $value as item()*) as map:map external;
declare %a:since("MarkLogic", "6.0") function map:get($map as map:map, $key as xs:string) as item()* external;
declare %a:since("MarkLogic", "6.0") function map:keys($map as map:map) as xs:string* external;
declare %a:since("MarkLogic", "6.0") function map:map() as map:map external;
declare %a:since("MarkLogic", "6.0") function map:map($map as element(map:map)) as map:map external;
declare %a:since("MarkLogic", "7.0") function map:new() as map:map external;
declare %a:since("MarkLogic", "7.0") function map:new($map as element(map:map)) as map:map external;
declare %a:since("MarkLogic", "6.0") function map:put($map as map:map, $key as xs:string, $value as item()*) as empty-sequence() external;
declare %a:since("MarkLogic", "9.0") function map:set-javascript-by-ref($map as map:map, $key as xs:boolean) as empty-sequence() external;
declare %a:since("MarkLogic", "9.0") function map:with($map as map:map, $key as xs:string, $value as item()*) as map:map external;


[bugfix] Fix an issue with String Constructor line endings test on Windows

xquery version "3.1";

module namespace sc="http://exist-db.org/xquery/test/string-constructor";

declare namespace test="http://exist-db.org/xquery/xqsuite";

declare variable $sc:win := map {
      "name": "Chris",
      "value": 10000,
      "taxed_value": 10000 - (10000 * 0.4),
      "in_ca": true()
    };

declare
    %test:assertEquals("Hello world!")
function sc:simple() {
    ``[Hello world!]``
};

(:
 : Character entities are not expanded, chars like <> are allowed.
 :)
declare
    %test:assertEquals("Hello &<world>{!}(:no comment:)")
function sc:special-chars() {
    ``[Hello &<world>{!}(:no comment:)]``
};

declare
    %test:assertEquals("Hello my world!")
function sc:simple-interpolation() {
    let $a := "my"
    return
        ``[Hello `{$a}` world!]``
};

declare
    %test:assertEquals('Hello "my" ''my'' world!')
function sc:simple-interpolation-quoted() {
    let $a := "my"
    return
        ``[Hello "`{$a}`" '`{$a}`' world!]``
};

declare
    %test:assertEquals("Hello my new world!")
function sc:simple-interpolation-sequence() {
    let $a := ("my", "new")
    return
        ``[Hello `{$a}` world!]``
};

declare
    %test:assertEquals("one fish", "two fish", "red fish", "blue fish")
function sc:simple-for() {
    for $s in ("one", "two", "red", "blue")
    return ``[`{$s}` fish]``
};

declare
    %test:assertEquals("1 literal text 2 more literal text")
function sc:nested() {
    let $i := 1
    let $j := 2
    return
        ``[`{ $i, ``[literal text]``, $j, ``[more literal text]`` }`]``
};

declare
    %test:assertEquals("Hello my world!")
function sc:path-interpolation() {
    let $a :=
my

    return
        ``[Hello `{$a/span}` world!]``
};

declare
    %test:assertEquals("I count 6!")
function sc:interpolation-funcall() {
    let $a := (1, 2, 3)
    return
        ``[I count `{sum($a)}`!]``
};

declare
    %test:assertXPath('count(tokenize($result, "\n")) eq 3')
function sc:newlines() {
``[Hello `{$sc:win?name}`
You have just won `{$sc:win?value}` dollars!
`{
   if ($sc:win?in_ca)
   then ``[Well, `{$sc:win?taxed_value}` dollars, after taxes.]``
   else ""
}`]``
};

xquery version "3.1";

module namespace sc="http://exist-db.org/xquery/test/string-constructor";

declare namespace test="http://exist-db.org/xquery/xqsuite";

declare variable $sc:win := map {
      "name": "Chris",
      "value": 10000,
      "taxed_value": 10000 - (10000 * 0.4),
      "in_ca": true()
    };

declare
    %test:assertEquals("Hello world!")
function sc:simple() {
    ``[Hello world!]``
};

(:
 : Character entities are not expanded, chars like <> are allowed.
 :)
declare
    %test:assertEquals("Hello &<world>{!}(:no comment:)")
function sc:special-chars() {
    ``[Hello &<world>{!}(:no comment:)]``
};

declare
    %test:assertEquals("Hello my world!")
function sc:simple-interpolation() {
    let $a := "my"
    return
        ``[Hello `{$a}` world!]``
};

declare
    %test:assertEquals('Hello "my" ''my'' world!')
function sc:simple-interpolation-quoted() {
    let $a := "my"
    return
        ``[Hello "`{$a}`" '`{$a}`' world!]``
};

declare
    %test:assertEquals("Hello my new world!")
function sc:simple-interpolation-sequence() {
    let $a := ("my", "new")
    return
        ``[Hello `{$a}` world!]``
};

declare
    %test:assertEquals("one fish", "two fish", "red fish", "blue fish")
function sc:simple-for() {
    for $s in ("one", "two", "red", "blue")
    return ``[`{$s}` fish]``
};

declare
    %test:assertEquals("1 literal text 2 more literal text")
function sc:nested() {
    let $i := 1
    let $j := 2
    return
        ``[`{ $i, ``[literal text]``, $j, ``[more literal text]`` }`]``
};

declare
    %test:assertEquals("Hello my world!")
function sc:path-interpolation() {
    let $a :=
my

    return
        ``[Hello `{$a/span}` world!]``
};

declare
    %test:assertEquals("I count 6!")
function sc:interpolation-funcall() {
    let $a := (1, 2, 3)
    return
        ``[I count `{sum($a)}`!]``
};

declare
    %test:assertEquals("Hello Chris
You have just won 10000 dollars!
Well, 6000 dollars, after taxes.")
function sc:newlines() {
``[Hello `{$sc:win?name}`
You have just won `{$sc:win?value}` dollars!
`{
   if ($sc:win?in_ca)
   then ``[Well, `{$sc:win?taxed_value}` dollars, after taxes.]``
   else ""
}`]``
};