[testsuite] Added %test:assertEqualsPermutation annotation.

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

xquery version "3.0";

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

xquery version "3.0";

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

(:~
 : Check the function's return value against each assertion.
 :)
declare %private function test:check-assertions($assertions as element(annotation)*, $result as item()*) as element(report)* {
    for $annotation in $assertions
    let $assert := replace($annotation/@name, "^\w+:(.*)$", "$1")
    return
        switch ($assert)
            case "assertEquals" return
                test:assertEquals($annotation/value/string(), $result)
            case "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
        ()
};

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


Formatting in conversion module for clarity

(:
 Copyright 2002-2016 MarkLogic Corporation.  All Rights Reserved.

 Licensed under the Apache License, Version 2.0 (the "License");
 you may not use this file except in compliance with the License.
 You may obtain a copy of the License at

     http://www.apache.org/licenses/LICENSE-2.0

 Unless required by applicable law or agreed to in writing, software
 distributed under the License is distributed on an "AS IS" BASIS,
 WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 See the License for the specific language governing permissions and
 limitations under the License.
:)
xquery version "1.0-ml";

module namespace es-codegen = "http://marklogic.com/entity-services-codegen";

import module namespace esi = "http://marklogic.com/entity-services-impl"
    at "entity-services-impl.xqy";

declare namespace es = "http://marklogic.com/entity-services";
declare namespace tde = "http://marklogic.com/xdmp/tde";

(:~
 : Generates an XQuery module that can be customized and used
 : to support transforms associated with an entity type
 : @param $entity-type  An entity type object.
 : @return An XQuery module (text) that can be edited and installed in a modules database.
 :)
declare function es-codegen:conversion-module-generate(
    $entity-type as map:map
) as document-node()
{
    let $default-base-uri := "http://example.org/"
    let $info := map:get($entity-type, "info")
    let $title := map:get($info, "title")
    let $prefix := lower-case(substring($title,1,1)) || substring($title,2)
    let $version:= map:get($info, "version")
    let $definitions := map:get($entity-type, "definitions")
    let $base-uri := fn:head((map:get($info, "baseUri"), $default-base-uri))
    let $base-uri :=
            if (fn:matches($base-uri, "[#/]$"))
            then $base-uri
            else concat($base-uri, "#")
    return
document {
<conversion-module>xquery version "1.0-ml";

(: This module was generated by MarkLogic Entity Services.
 : The source entity type document was {$title}-{$version}
 :
 : Modification History:
 :   Generated at timestamp: {fn:current-dateTime()}
 :   Persisted by AUTHOR
 :   Date: DATE
 :)
module namespace {$prefix} = "{$base-uri}{$title}-{$version}";

import module namespace es = "http://marklogic.com/entity-services"
    at "/MarkLogic/entity-services/entity-services.xqy";

declare private function {$prefix}:include-if-exists(
    $property-path,
    $instance,
    $property-key,
    $value
) as empty-sequence()
{{
    if (exists($property-path))
    then
    map:put($instance, $property-key, $value)
    else ()
}};

(: extract-instance-{{entity-type}} Functions :)
{
    for $entity-type-key in map:keys(map:get($entity-type, "definitions"))
    return
    <extract-instance>
(:~
    TODO make descriptive comment for extract-instance-{$entity-type-key}
 :)
declare function {$prefix}:extract-instance-{$entity-type-key}(
    $source-node as node()
) as map:map
{{
    let $instance := json:object()
    let $_ := map:put($instance, "$type", "{ $entity-type-key }")
    let $_ := map:put($instance, "$attachments", $source-node)
    {
    (: Begin code generation block :)
    let $this-type := map:get($definitions, $entity-type-key)
    let $properties-map := map:get($this-type, "properties")
    let $properties-keys := map:keys($properties-map)
    for $property-key in map:keys($properties-map)
    let $is-array :=
            map:get(map:get($properties-map, $property-key), "datatype")
            eq "array"
    let $wrap-if-array := function($str) {
            if ($is-array)
            then concat("json:to-array(", $str, " ! data(.))")
            else concat("data(", $str, ")")
        }
    let $ref :=
        if ($is-array)
        then map:get(map:get(map:get($properties-map, $property-key), "items"), "$ref")
        else map:get(map:get($properties-map, $property-key), "$ref")
    let $path-to-property := concat("$source-node/", $entity-type-key, "/", $property-key)
    let $value :=
        if (empty($ref))
        then
            $wrap-if-array($path-to-property)
        else
            if(contains($ref, "#/definitions"))
            then
            concat("
    if (", $path-to-property, "/element())",
                   "
    then json:to-array(",
                    $path-to-property, " ! ", $prefix, ":extract-instance-", replace($ref, "#/definitions/", ""), "(.))",
                   "
    else data(",
                   $path-to-property,
                   ")")
            else
               concat($path-to-property, "/node()")

    return
    (: include a call to conditional map:put :)
    concat("let $_ := ",
            $prefix,
            ":include-if-exists(",
            $path-to-property,
            ", $instance, '",
            $property-key,
            "', ",
            $value,
            ")
   "
          )
    (: end code generation block :)
    }
    return $instance
}};
    </extract-instance>/text()
}

(: instance-to-canonical-xml function
 : Depending on the relationships among your entity types
 : you may wish to modify sections of this function
 : to meet your own purposes.
 :)
declare function {$prefix}:instance-to-canonical-xml(
    $entity-instance as map:map
) as element()
{{
    (: Construct an element that is named the same as the Entity Type :)
    element {{ map:get($entity-instance, "$type") }}  {{
        for $key in map:keys($entity-instance)
        let $instance-property := map:get($entity-instance, $key)
        where ($key castable as xs:NCName and $key ne "$type")
        return
            typeswitch ($instance-property)
            (: This branch handles embedded objects.  You can choose to prune
               an entity's representation of extend it with lookups here. :)
            case json:object+
                return
                    for $prop in $instance-property
                    return element {{ $key }} {{ {$prefix}:instance-to-canonical-xml($prop) }}
            (: An array can also treated as multiple elements :)
            case json:array
                return
                    for $val in json:array-values($instance-property)
                    return
                        if ($val instance of json:object)
                        then element {{ $key }} {{ {$prefix}:instance-to-canonical-xml($val) }}
                        else element {{ $key }} {{ $val }}
            (: A sequence of values should be simply treated as multiple elements :)
            case item()+
                return
                    for $val in $instance-property
                    return element {{ $key }} {{ $val }}
            default return element {{ $key }} {{ $instance-property }}
    }}
}};

(: instance-to-envelope
 : This function is used to wrap sources and entity instances
 : within the same document
 : TODO EA-3, this will be part of XQuery server library, not generated code.
 :)
declare function {$prefix}:instance-to-envelope(
    $entity-instance as map:map
) as document-node()
{{
    document {{
        element es:envelope {{
            element es:instance {{
                element es:info {{
                    element es:title {{ "{$title}" }},
                    element es:version {{ "{$version}" }}
                }},
                {$prefix}:instance-to-canonical-xml($entity-instance)
            }},
            element es:attachments {{
                map:get($entity-instance, "$attachments")
            }}
        }}
    }}
}};

(: instance-from-document
 : if you have modified instance-to-envelope
 : you may need also to modify this function
 :)
declare function {$prefix}:instance-from-document(
    $document as document-node()
) as map:map*
{{
    let $xml-from-document := {$prefix}:instance-xml-from-document($document)
    for $root-instance in $xml-from-document
        let $instance := json:object()
        let $_ :=
            for $property in $root-instance/*
            return
                if ($property/element())
                then map:put($instance, local-name($property), $property/* ! {$prefix}:child-instance(.))
                else map:put($instance, local-name($property), data($property))
        return $instance
}};

declare function {$prefix}:child-instance(
    $element as element()
) as map:map*
{{
    let $child := json:object()
    let $_ :=
        for $property in $element/*
        return
            if ($property/element())
            then map:put($child, local-name($property), {$prefix}:child-instance($property))
            else map:put($child, local-name($property), data($property))
    return $child
}};

(:~
 : Returns all XML from within a document envelope except the es:info.
 : This function is generic enough not to require customization for
 : most entity type implementations.
 :)
declare function {$prefix}:instance-xml-from-document(
    $document as document-node()
) as element()
{{
    $document//es:instance/(* except es:info)
}};

declare function {$prefix}:instance-json-from-document(
    $document as document-node()
) as object-node()
{{
    let $instance := {$prefix}:instance-from-document($document)
    return xdmp:to-json($instance)/node()
}};

declare function {$prefix}:instance-get-attachments(
    $document as document-node()
) as element()*
{{
    $document//es:attachments/*
}};

</conversion-module>/text()
}

};

(:
 Copyright 2002-2016 MarkLogic Corporation.  All Rights Reserved.

 Licensed under the Apache License, Version 2.0 (the "License");
 you may not use this file except in compliance with the License.
 You may obtain a copy of the License at

     http://www.apache.org/licenses/LICENSE-2.0

 Unless required by applicable law or agreed to in writing, software
 distributed under the License is distributed on an "AS IS" BASIS,
 WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 See the License for the specific language governing permissions and
 limitations under the License.
:)
xquery version "1.0-ml";

module namespace es-codegen = "http://marklogic.com/entity-services-codegen";

import module namespace esi = "http://marklogic.com/entity-services-impl"
    at "entity-services-impl.xqy";

declare namespace es = "http://marklogic.com/entity-services";
declare namespace tde = "http://marklogic.com/xdmp/tde";

(:~
 : Generates an XQuery module that can be customized and used
 : to support transforms associated with an entity type
 : @param $entity-type  An entity type object.
 : @return An XQuery module (text) that can be edited and installed in a modules database.
 :)
declare function es-codegen:conversion-module-generate(
    $entity-type as map:map
) as document-node()
{
    let $default-base-uri := "http://example.org/"
    let $info := map:get($entity-type, "info")
    let $title := map:get($info, "title")
    let $prefix := lower-case(substring($title,1,1)) || substring($title,2)
    let $version:= map:get($info, "version")
    let $definitions := map:get($entity-type, "definitions")
    let $base-uri := fn:head((map:get($info, "baseUri"), $default-base-uri))
    let $base-uri :=
            if (fn:matches($base-uri, "[#/]$"))
            then $base-uri
            else concat($base-uri, "#")
    return
document {
<conversion-module>xquery version "1.0-ml";

(: This module was generated by MarkLogic Entity Services.
 : The source entity type document was {$title}-{$version}
 :
 : Modification History:
 :   Generated at timestamp: {fn:current-dateTime()}
 :   Persisted by AUTHOR
 :   Date: DATE
 :)
module namespace {$prefix} = "{$base-uri}{$title}-{$version}";

import module namespace es = "http://marklogic.com/entity-services"
    at "/MarkLogic/entity-services/entity-services.xqy";

declare private function {$prefix}:include-if-exists(
    $property-path,
    $instance,
    $property-key,
    $value
) as empty-sequence()
{{
    if (exists($property-path))
    then
    map:put($instance, $property-key, $value)
    else ()
}};

(: extract-instance-{{entity-type}} Functions :)
{
    for $entity-type-key in map:keys(map:get($entity-type, "definitions"))
    return
    <extract-instance>
(:~
    TODO make descriptive comment for extract-instance-{$entity-type-key}
 :)
declare function {$prefix}:extract-instance-{$entity-type-key}(
    $source-node as node()
) as map:map
{{
    let $instance := json:object()
    let $_ := map:put($instance, "$type", "{ $entity-type-key }")
    let $_ := map:put($instance, "$attachments", $source-node)
    {
    (: Begin code generation block :)
    let $this-type := map:get($definitions, $entity-type-key)
    let $properties-map := map:get($this-type, "properties")
    let $properties-keys := map:keys($properties-map)
    for $property-key in map:keys($properties-map)
    let $is-array :=
            map:get(map:get($properties-map, $property-key), "datatype")
            eq "array"
    let $wrap-if-array := function($str) {
            if ($is-array)
            then concat("json:to-array(", $str, " ! data(.))")
            else concat("data(", $str, ")")
        }
    let $ref :=
        if ($is-array)
        then map:get(map:get(map:get($properties-map, $property-key), "items"), "$ref")
        else map:get(map:get($properties-map, $property-key), "$ref")
    let $path-to-property := concat("$source-node/", $entity-type-key, "/", $property-key)
    let $value :=
        if (empty($ref))
        then
            $wrap-if-array($path-to-property)
        else
            if(contains($ref, "#/definitions"))
            then
            concat("if (not(",
                    $path-to-property,
                    "/element()))
then data(",
                    $path-to-property,
                    ")
else json:to-array(",
                    $path-to-property,
                    " ! ",
                    $prefix,
                    ":extract-instance-",
                    replace($ref, "#/definitions/", ""),
                    "(.))"
                    )
            else
               concat($path-to-property, "/node()")

    return
    (: include a call to conditional map:put :)
    concat("let $_ := ",
            $prefix,
            ":include-if-exists(",
            $path-to-property,
            ", $instance, '",
            $property-key,
            "', ",
            $value,
            ")
   "
          )
    (: end code generation block :)
    }
    return $instance
}};
    </extract-instance>/text()
}

(: instance-to-canonical-xml function
 : Depending on the relationships among your entity types
 : you may wish to modify sections of this function
 : to meet your own purposes.
 :)
declare function {$prefix}:instance-to-canonical-xml(
    $entity-instance as map:map
) as element()
{{
    (: Construct an element that is named the same as the Entity Type :)
    element {{ map:get($entity-instance, "$type") }}  {{
        for $key in map:keys($entity-instance)
        let $instance-property := map:get($entity-instance, $key)
        where ($key castable as xs:NCName and $key ne "$type")
        return
            typeswitch ($instance-property)
            (: This branch handles embedded objects.  You can choose to prune
               an entity's representation of extend it with lookups here. :)
            case json:object+
                return
                    for $prop in $instance-property
                    return element {{ $key }} {{ {$prefix}:instance-to-canonical-xml($prop) }}
            (: An array can also treated as multiple elements :)
            case json:array
                return
                    for $val in json:array-values($instance-property)
                    return
                        if ($val instance of json:object)
                        then element {{ $key }} {{ {$prefix}:instance-to-canonical-xml($val) }}
                        else element {{ $key }} {{ $val }}
            (: A sequence of values should be simply treated as multiple elements :)
            case item()+
                return
                    for $val in $instance-property
                    return element {{ $key }} {{ $val }}
            default return element {{ $key }} {{ $instance-property }}
    }}
}};

(: instance-to-envelope
 : This function is used to wrap sources and entity instances
 : within the same document
 : TODO EA-3, this will be part of XQuery server library, not generated code.
 :)
declare function {$prefix}:instance-to-envelope(
    $entity-instance as map:map
) as document-node()
{{
    document {{
        element es:envelope {{
            element es:instance {{
                element es:info {{
                    element es:title {{ "{$title}" }},
                    element es:version {{ "{$version}" }}
                }},
                {$prefix}:instance-to-canonical-xml($entity-instance)
            }},
            element es:attachments {{
                map:get($entity-instance, "$attachments")
            }}
        }}
    }}
}};

(: instance-from-document
 : if you have modified instance-to-envelope
 : you may need also to modify this function
 :)
declare function {$prefix}:instance-from-document(
    $document as document-node()
) as map:map*
{{
    let $xml-from-document := {$prefix}:instance-xml-from-document($document)
    for $root-instance in $xml-from-document
        let $instance := json:object()
        let $_ :=
            for $property in $root-instance/*
            return
                if ($property/element())
                then map:put($instance, local-name($property), $property/* ! {$prefix}:child-instance(.))
                else map:put($instance, local-name($property), data($property))
        return $instance
}};

declare function {$prefix}:child-instance(
    $element as element()
) as map:map*
{{
    let $child := json:object()
    let $_ :=
        for $property in $element/*
        return
            if ($property/element())
            then map:put($child, local-name($property), {$prefix}:child-instance($property))
            else map:put($child, local-name($property), data($property))
    return $child
}};

(:~
 : Returns all XML from within a document envelope except the es:info.
 : This function is generic enough not to require customization for
 : most entity type implementations.
 :)
declare function {$prefix}:instance-xml-from-document(
    $document as document-node()
) as element()
{{
    $document//es:instance/(* except es:info)
}};

declare function {$prefix}:instance-json-from-document(
    $document as document-node()
) as object-node()
{{
    let $instance := {$prefix}:instance-from-document($document)
    return xdmp:to-json($instance)/node()
}};

declare function {$prefix}:instance-get-attachments(
    $document as document-node()
) as element()*
{{
    $document//es:attachments/*
}};

</conversion-module>/text()
}

};


[tweak] tweaked repo manager ui

[tweak] tweaked repo manager ui

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

xquery version "1.0";

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

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

declare function repomanager:upload() as element()
{
    let $name := request:get-parameter("name", ()),
    $repocol :=  if (collection('/db/system/repo')) then () else xmldb:create-collection('/db/system','repo'),
    $docName := if($name) then $name else request:get-uploaded-file-name("upload"),
    $file := request:get-uploaded-file-data("upload") return

Actions:

                {
                if (contains($docName,'.xar')) then
                    (
uploaded package: {$docName}
,

                    xdb:decode-uri(xs:anyURI(xdb:store('/db/system/repo', xdb:encode-uri($docName), $file)))
                    )
                else

Error uploading - Must be a valid Package archive (.xar file extension)

                }

};

declare function repomanager:activate() as element()
{
    let $name := request:get-parameter("name", ()),
    $hostname := request:get-hostname(),            (:  pkg-repo.jar needs http or file scheme :)
    $port := request:get-server-port()
     return

Actions:

activated package: {$name}

                {
                    repo:install(concat('http://',$hostname,':',$port,'/exist/rest/db/system/repo/',$name,'.xar'))
                }

};

declare function repomanager:deactivate() as element()
{
    let $name := request:get-parameter("name", ())
     return

Actions:

deactivated package: {$name}

                {
                    repo:remove($name)
                }

};

declare function repomanager:remove() as element()
{
    let $name := request:get-parameter("name", ())
     return

Actions:

removed package: {$name}

                {xmldb:remove('/db/system/repo',concat($name,'.xar'))}

};

declare function repomanager:process-action() as element()*
{
    let $action := request:get-parameter("action", ()) return
        util:catch("java.lang.Exception",
            if($action eq "remove") then
            (
                repomanager:remove()
            )
            else if($action eq "activate") then
            (
                repomanager:activate()
            )
            else if($action eq "deactivate") then
            (
                repomanager:deactivate()
            )
            else if($action eq "Upload Package") then
            (
                repomanager:upload()
            )else(),

                An error occurred while processing the action:

                {$util:exception-message}

        )
};

declare function repomanager:main() as element() {
    let $action := lower-case(request:get-parameter("action", "refresh"))
    let $repocol :=  if (collection('/db/system/repo')) then () else xmldb:create-collection('/db/system','repo')

    return

Package Repository

            <form method="POST" enctype="multipart/form-data">

         { repomanager:process-action() }

                Package
                Date Uploaded
                Installed
                Action

        {
         let $files := if (collection('/db/system/repo')) then collection('/db/system/repo')/util:document-name(.) else ()
         let $repos := repo:list()
         return

            for $file in $files
            let $package-name := substring-before($file,'.xar')
            let $installed := exists($repos[. eq $package-name])
            return

                {$package-name}
                {xmldb:last-modified('/db/system/repo', concat($package-name,'.xar'))}

                {if ($installed) then
                    {$installed}
                else
                    {$installed}
                }

                {
                if($installed) then
                  deactivate

                 else
                 ( activate,' | ',
                 remove
                 )
                }

            }

                        <input type="submit" name="action" value="Upload Package"/>
                        <input type="file" size="30" name="upload"/>

 You can find example .xar packages located under webapp/repo/packages

Note: link to eXist-db own public package repository coming soon ....

          </form>

};

xquery version "1.0";

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

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

declare function repomanager:upload() as element()
{
    let $name := request:get-parameter("name", ()),
    $repocol :=  if (collection('/db/system/repo')) then () else xmldb:create-collection('/db/system','repo'),
    $docName := if($name) then $name else request:get-uploaded-file-name("upload"),
    $file := request:get-uploaded-file-data("upload") return

Actions:

                {
                if (contains($docName,'.xar')) then
                    (
uploaded package: {$docName}
,

                    xdb:decode-uri(xs:anyURI(xdb:store('/db/system/repo', xdb:encode-uri($docName), $file)))
                    )
                else

Error uploading - Must be a valid Package archive (.xar file extension)

                }

};

declare function repomanager:activate() as element()
{
    let $name := request:get-parameter("name", ()),
    $hostname := request:get-hostname(),            (:  pkg-repo.jar needs http or file scheme :)
    $port := request:get-server-port()
     return

Actions:

activated package: {$name}

                {
                    repo:install(concat('http://',$hostname,':',$port,'/exist/rest/db/system/repo/',$name,'.xar'))
                }

};

declare function repomanager:deactivate() as element()
{
    let $name := request:get-parameter("name", ())
     return

Actions:

deactivated package: {$name}

                {
                    repo:remove($name)
                }

};

declare function repomanager:remove() as element()
{
    let $name := request:get-parameter("name", ())
     return

Actions:

removed package: {$name}

                {xmldb:remove('/db/system/repo',concat($name,'.xar'))}

};

declare function repomanager:process-action() as element()*
{
    let $action := request:get-parameter("action", ()) return
        util:catch("java.lang.Exception",
            if($action eq "remove") then
            (
                repomanager:remove()
            )
            else if($action eq "activate") then
            (
                repomanager:activate()
            )
            else if($action eq "deactivate") then
            (
                repomanager:deactivate()
            )
            else if($action eq "Upload Package") then
            (
                repomanager:upload()
            )else(),

                An error occurred while processing the action:

                {$util:exception-message}

        )
};

declare function repomanager:main() as element() {
    let $action := lower-case(request:get-parameter("action", "refresh"))
    let $repocol :=  if (collection('/db/system/repo')) then () else xmldb:create-collection('/db/system','repo')

    return

Package Repository

            <form method="POST" enctype="multipart/form-data">

         { repomanager:process-action() }

                Package
                Date installed
                Installed
                Action

        {
         let $files := if (collection('/db/system/repo')) then collection('/db/system/repo')/util:document-name(.) else ()
         let $repos := repo:list()
         return

            for $file in $files
            let $package-name := substring-before($file,'.xar')
            let $installed := exists($repos[. eq $package-name])
            return

                {$package-name}
                {xmldb:last-modified('/db/system/repo', concat($package-name,'.xar'))}

                {if ($installed) then
                    {$installed}
                else
                    {$installed}
                }

                {
                if($installed) then
                  deactivate

                 else
                 ( activate,' | ',
                 remove
                 )
                }

            }

                        <input type="submit" name="action" value="Upload Package"/>
                        <input type="file" size="30" name="upload"/>

 You can find example .xar packages located under webapp/repo/packages

Note: link to eXist-db own public package repository coming soon ....

          </form>

};


Renaming of different highlight contents variables

declare default element namespace "http://www.w3.org/1999/xhtml";
declare namespace xfdf="http://ns.adobe.com/xfdf/";

declare namespace functx = "http://www.functx.com";
declare function functx:trim
  ( $arg as xs:string? )  as xs:string {

   replace(replace($arg,'\s+$',''),'^\s+','')
 };

<xhtml>

Issue #	Section	Page	Author	Observation

{
  for $h at $issue in //xfdf:highlight
  let $page := fn:string($h/@page + 1) (: XFDF page numbers are 0-based :)
  let $author := fn:string($h/@title)
  let $contents := $h/xfdf:contents/text()
  let $rich_contents := $h/xfdf:contents-richtext/body/p/span/text()
  let $content := fn:concat($contents,$rich_contents)
  let $tokenized_comment := fn:tokenize($content, ":")
  let $comment := functx:trim($tokenized_comment[2])
  let $section := fn:string($h/@subject) (: if it exists, it might include context :)
  let $section := fn:concat($section, fn:string(functx:trim($tokenized_comment[1])))
  return
{fn:string($issue)}	{$section}	{$page}	{$author}	{$comment}

}

</xhtml>

declare default element namespace "http://www.w3.org/1999/xhtml";
declare namespace xfdf="http://ns.adobe.com/xfdf/";

declare namespace functx = "http://www.functx.com";
declare function functx:trim
  ( $arg as xs:string? )  as xs:string {

   replace(replace($arg,'\s+$',''),'^\s+','')
 };

<xhtml>

Issue #	Section	Page	Author	Observation

{
  for $h at $issue in //xfdf:highlight
  let $page := fn:string($h/@page + 1) (: XFDF page numbers are 0-based :)
  let $author := fn:string($h/@title)
  let $comment := $h/xfdf:contents/text()
  let $rich_comment := $h/xfdf:contents-richtext/body/p/span/text()
  let $comment := fn:concat($comment,$rich_comment)
  let $tokenized_comment := fn:tokenize($comment, ":")
  let $comment := functx:trim($tokenized_comment[2])
  let $section := fn:string($h/@subject) (: if it exists, it might include context :)
  let $section := fn:concat($section, fn:string(functx:trim($tokenized_comment[1])))
  return
{fn:string($issue)}	{$section}	{$page}	{$author}	{$comment}

}

</xhtml>


remove whitespace

remove whitespace

module namespace page = 'http://basex.org/modules/web-page';

import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace csd_webui =  "https://github.com/openhie/openinfoman/csd_webui";
import module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";
declare   namespace   xforms = "http://www.w3.org/2002/xforms";
declare namespace xs = "http://www.w3.org/2001/XMLSchema";
declare   namespace   csd = "urn:ihe:iti:csd:2013";
declare default element  namespace   "urn:ihe:iti:csd:2013";

declare variable $page:xsl := "../resources/doc_careServiceFunctions.xsl";

declare
  %rest:path("/CSD/storedFunctions")
  %rest:GET
  %output:method("xhtml")
  function page:csr_list()
{
  let $content:=

Registered Stored Queries

{count(csr_proc:stored_functions($csd_webconf:db))} Stored Functions

{count(csr_proc:stored_updating_functions($csd_webconf:db))} Stored Updating Functions

    Export Documentation

Export Functions

Clear All Stored Functions

  let $list := page:function_list()
  return csd_webui:wrapper(($content,$list))
};

declare  updating
  %rest:path("/CSD/storedFunctions/delete/{$urn}")
  function page:delete($urn)
  {
    (
      csr_proc:delete_stored_function($csd_webconf:db,$urn),
      csd_webui:redirect_out("CSD/storedFunctions")
    )

};

declare
  %rest:path("/CSD/storedFunctions/download/{$urn}")
  function page:download($urn)
  {
    let $node := (
      csr_proc:get_function_definition($csd_webconf:db,$urn),
      csr_proc:get_updating_function_definition($csd_webconf:db,$urn)
    )[1]
    return $node

};

declare  updating
  %rest:path("/CSD/storedFunctions/clear")
  function page:clear()
  {
    (
      csr_proc:clear_stored_functions($csd_webconf:db),
      csd_webui:redirect_out("CSD/storedFunctions")
    )

};

declare function page:display_function($function,$updating) {
  let  $urn := string($function/@urn)
  return
    {if ($updating) then  "(Updating) " else ()}
    URN: {string($urn)}

    Method:

{string($function/definition)}

    Content: {string(csr_proc:lookup_stored_content_type($csd_webconf:db,$urn)) }

    Description:
{$function/description}

    Instance:

{serialize($function/xforms:instance/careServicesRequest,map{'indent':'yes'})}

    {if (exists($function/@method)) then  ("Method: ",string($function/@method),
) else () }
    {if (exists($function/xs:schema)) then  ("Schema: ",string($function/xs:schema),
) else () }
    {if (count( $function/xforms:bind) > 0) then
    ("Bindings: ",

        {for $bind in $function/xforms:bind return
Node set: {string($bind/@nodeset)}
Type: {string($bind/@type)}
}

    ) else ()
    }

};

declare
  %rest:path("/CSD/storedFunctions/export_funcs")
  %rest:GET
  function page:export_funcs()
{
  <careServiceFunctions
    xmlns:xforms="http://www.w3.org/2002/xforms"
    xmlns:csd="urn:ihe:iti:csd:2013"
    xmlns:xi="http://www.w3.org/2001/XInclude"
    xmlns:xsd="http://www.w3.org/2001/XMLSchema"
    xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
    xmlns:hfp="http://www.w3.org/2001/XMLSchema-hasFacetAndProperty"
     >
  {(
    csr_proc:stored_functions($csd_webconf:db)
    ,csr_proc:stored_updating_functions($csd_webconf:db)
   )}
 </careServiceFunctions>
};

declare
  %rest:path("/CSD/storedFunctions/export_doc")
  %rest:GET
  %output:method("xhtml")
  function page:export_doc()
{
  let $funcs :=
  <careServiceFunctions
    xmlns:xforms="http://www.w3.org/2002/xforms"
    xmlns:csd="urn:ihe:iti:csd:2013"
    xmlns:xi="http://www.w3.org/2001/XInclude"
    xmlns:xsd="http://www.w3.org/2001/XMLSchema"
    xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
    xmlns:hfp="http://www.w3.org/2001/XMLSchema-hasFacetAndProperty"
     >
  {(
    csr_proc:stored_functions($csd_webconf:db)
    ,csr_proc:stored_updating_functions($csd_webconf:db)
   )}
 </careServiceFunctions>
(: return $funcs :)
 return xslt:transform($funcs,doc($page:xsl))
};

declare function page:function_list()  {

Function List

    {
      for $function in (csr_proc:stored_functions($csd_webconf:db),csr_proc:stored_updating_functions($csd_webconf:db))
      return

URN: {string($function/@urn)} {"  "}

	{substring(string($function/description),1,100)}
	{if (string-length(string($function/description)) > 100) then "..." else ()}

      View
      Download
      Delete

    }

    {
      (
	for $function in csr_proc:stored_functions($csd_webconf:db)
	return
{page:display_function($function,false())}

       ,
        for $function in csr_proc:stored_updating_functions($csd_webconf:db)
        return
{page:display_function($function,true())}

      )
    }

};

declare
  %rest:path("/CSD/storedFunctions.json")
  %rest:GET
  function page:export_function_details_json()
  {
  xml-to-json(page:get_export_function_details())
  };

declare
  %rest:path("/CSD/storedFunctions.xml")
  %rest:GET
  function page:export_function_details_xml(){
    page:get_export_function_details()
};

declare function page:get_export_function_details() {
    <map xmlns="http://www.w3.org/2005/xpath-functions">
      {
	for $function in (csr_proc:stored_functions($csd_webconf:db))
	let $urn:= string($function/@urn)
	return
	<map key="{$urn}">
	  <boolean key="updating">false</boolean>
	  <string key="description">{string($function/description)}</string>
	  <string key="definition">{string($function/definition)}</string>
	  <string key="content-type">{string(csr_proc:lookup_stored_content_type($csd_webconf:db,$urn))}</string>
	</map>
      }
      {
	for $function in (csr_proc:stored_updating_functions($csd_webconf:db))
	let $urn:= string($function/@urn)
	return
	<map key="{string($function/@urn)}">
	  <boolean key="updating">true</boolean>
	  <string key="description">{string($function/description)}</string>
	  <string key="definition">{string($function/definition)}</string>
	  <string key="content-type">{string(csr_proc:lookup_stored_content_type($csd_webconf:db,$urn))}</string>
	</map>

      }
    </map>
};

module namespace page = 'http://basex.org/modules/web-page';

import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace csd_webui =  "https://github.com/openhie/openinfoman/csd_webui";
import module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";
declare   namespace   xforms = "http://www.w3.org/2002/xforms";
declare namespace xs = "http://www.w3.org/2001/XMLSchema";
declare   namespace   csd = "urn:ihe:iti:csd:2013";
declare default element  namespace   "urn:ihe:iti:csd:2013";

declare variable $page:xsl := "../resources/doc_careServiceFunctions.xsl";

declare
  %rest:path("/CSD/storedFunctions")
  %rest:GET
  %output:method("xhtml")
  function page:csr_list()
{
  let $content:=

Registered Stored Queries

{count(csr_proc:stored_functions($csd_webconf:db))} Stored Functions

{count(csr_proc:stored_updating_functions($csd_webconf:db))} Stored Updating Functions

    Export Documentation

Export Functions

Clear All Stored Functions

  let $list := page:function_list()
  return csd_webui:wrapper(($content,$list))
};

declare  updating
  %rest:path("/CSD/storedFunctions/delete/{$urn}")
  function page:delete($urn)
  {
    (
      csr_proc:delete_stored_function($csd_webconf:db,$urn),
      csd_webui:redirect_out("CSD/storedFunctions")
    )

};

declare
  %rest:path("/CSD/storedFunctions/download/{$urn}")
  function page:download($urn)
  {
    let $node := (
      csr_proc:get_function_definition($csd_webconf:db,$urn),
      csr_proc:get_updating_function_definition($csd_webconf:db,$urn)
    )[1]
    return $node

};

declare  updating
  %rest:path("/CSD/storedFunctions/clear")
  function page:clear()
  {
    (
      csr_proc:clear_stored_functions($csd_webconf:db),
      csd_webui:redirect_out("CSD/storedFunctions")
    )

};

  csr_proc:init($csd_webconf:db)

declare function page:display_function($function,$updating) {
  let  $urn := string($function/@urn)
  return
    {if ($updating) then  "(Updating) " else ()}
    URN: {string($urn)}

    Method:

{string($function/definition)}

    Content: {string(csr_proc:lookup_stored_content_type($csd_webconf:db,$urn)) }

    Description:
{$function/description}

    Instance:

{serialize($function/xforms:instance/careServicesRequest,map{'indent':'yes'})}

    {if (exists($function/@method)) then  ("Method: ",string($function/@method),
) else () }
    {if (exists($function/xs:schema)) then  ("Schema: ",string($function/xs:schema),
) else () }
    {if (count( $function/xforms:bind) > 0) then
    ("Bindings: ",

        {for $bind in $function/xforms:bind return
Node set: {string($bind/@nodeset)}
Type: {string($bind/@type)}
}

    ) else ()
    }

};

declare
  %rest:path("/CSD/storedFunctions/export_funcs")
  %rest:GET
  function page:export_funcs()
{
  <careServiceFunctions
    xmlns:xforms="http://www.w3.org/2002/xforms"
    xmlns:csd="urn:ihe:iti:csd:2013"
    xmlns:xi="http://www.w3.org/2001/XInclude"
    xmlns:xsd="http://www.w3.org/2001/XMLSchema"
    xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
    xmlns:hfp="http://www.w3.org/2001/XMLSchema-hasFacetAndProperty"
     >
  {(
    csr_proc:stored_functions($csd_webconf:db)
    ,csr_proc:stored_updating_functions($csd_webconf:db)
   )}
 </careServiceFunctions>
};

declare
  %rest:path("/CSD/storedFunctions/export_doc")
  %rest:GET
  %output:method("xhtml")
  function page:export_doc()
{
  let $funcs :=
  <careServiceFunctions
    xmlns:xforms="http://www.w3.org/2002/xforms"
    xmlns:csd="urn:ihe:iti:csd:2013"
    xmlns:xi="http://www.w3.org/2001/XInclude"
    xmlns:xsd="http://www.w3.org/2001/XMLSchema"
    xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
    xmlns:hfp="http://www.w3.org/2001/XMLSchema-hasFacetAndProperty"
     >
  {(
    csr_proc:stored_functions($csd_webconf:db)
    ,csr_proc:stored_updating_functions($csd_webconf:db)
   )}
 </careServiceFunctions>
(: return $funcs :)
 return xslt:transform($funcs,doc($page:xsl))
};

declare function page:function_list()  {

Function List

    {
      for $function in (csr_proc:stored_functions($csd_webconf:db),csr_proc:stored_updating_functions($csd_webconf:db))
      return

URN: {string($function/@urn)} {"  "}

	{substring(string($function/description),1,100)}
	{if (string-length(string($function/description)) > 100) then "..." else ()}

      View
      Download
      Delete

    }

    {
      (
	for $function in csr_proc:stored_functions($csd_webconf:db)
	return
{page:display_function($function,false())}

       ,
        for $function in csr_proc:stored_updating_functions($csd_webconf:db)
        return
{page:display_function($function,true())}

      )
    }

};

declare
  %rest:path("/CSD/storedFunctions.json")
  %rest:GET
  function page:export_function_details_json()
  {
  xml-to-json(page:get_export_function_details())
  };

declare
  %rest:path("/CSD/storedFunctions.xml")
  %rest:GET
  function page:export_function_details_xml(){
    page:get_export_function_details()
};

declare function page:get_export_function_details() {
    <map xmlns="http://www.w3.org/2005/xpath-functions">
      {
	for $function in (csr_proc:stored_functions($csd_webconf:db))
	let $urn:= string($function/@urn)
	return
	<map key="{$urn}">
	  <boolean key="updating">false</boolean>
	  <string key="description">{string($function/description)}</string>
	  <string key="definition">{string($function/definition)}</string>
	  <string key="content-type">{string(csr_proc:lookup_stored_content_type($csd_webconf:db,$urn))}</string>
	</map>
      }
      {
	for $function in (csr_proc:stored_updating_functions($csd_webconf:db))
	let $urn:= string($function/@urn)
	return
	<map key="{string($function/@urn)}">
	  <boolean key="updating">true</boolean>
	  <string key="description">{string($function/description)}</string>
	  <string key="definition">{string($function/definition)}</string>
	  <string key="content-type">{string(csr_proc:lookup_stored_content_type($csd_webconf:db,$urn))}</string>
	</map>

      }
    </map>
};


Correcton in parameter passing to call editObjectClass

xquery version "1.0";

declare namespace openMDR = "http://www.cagrid.org/schema/openMDR";
declare namespace ISO11179= "http://www.cagrid.org/schema/ISO11179";
declare namespace request="http://exist-db.org/xquery/request";
declare namespace session="http://exist-db.org/xquery/session";
(: Using eXist-predefined namespace: xmldb :)

import module
    namespace lib-util="http://www.cagrid.org/xquery/library/util"
    at "../library/m-lib-util.xquery";

import module namespace
   administered-item="http://www.cagrid.org/xquery/library/administered-item"
   at "../library/m-administered-item.xquery";

import module
    namespace lib-rendering="http://www.cagrid.org/xquery/library/rendering"
    at "../web/m-lib-rendering.xquery";

import module namespace
    lib-uri-resolution="http://www.cagrid.org/xquery/library/resolver"
    at "../resolver/m-lib-uri-resolution.xquery";

declare function local:content($administered_item) as element(div)
{

{
      (if ($administered_item//openMDR:reference_uri)
      then (

Object Class Specific Attributes

             {
             for $reference_uris in $administered_item//openMDR:reference_uri
             let $reference_uri := data($reference_uris//openMDR:reference_uri)
             return

Reference URI	{lib-uri-resolution:html-anchor($reference_uri)}

             }

      )
      else (

Object Class Specific Attributes

reference URI or relationships undefined

      ),
      lib-rendering:render_administered_item($administered_item))

   }

};

declare option exist:serialize "media-type=text/html method=xhtml doctype-public=-//W3C//DTD XHTML 1.0 Transitional//EN doctype-system=http://www.w3.org/TR/2002/REC-xhtml1-20020801/DTD/xhtml1-transitional.dtd";

session:create(),
   let $compound_id := request:get-parameter("compound_id", "")
   let $administered_item := lib-util:mdrElement("object_class",$compound_id)
   let $title:=concat('Object class: ',administered-item:preferred-name($administered_item))
   return
      if (request:get-parameter("as-xml",()))
      then (lib-rendering:as-xml($administered_item))
      else(lib-rendering:txfrm-webpage($title, local:content($administered_item), true(), true(), $compound_id, 'object_class.xquery','../edit/editObjectClass.xquery'))

xquery version "1.0";

declare namespace openMDR = "http://www.cagrid.org/schema/openMDR";
declare namespace ISO11179= "http://www.cagrid.org/schema/ISO11179";
declare namespace request="http://exist-db.org/xquery/request";
declare namespace session="http://exist-db.org/xquery/session";
(: Using eXist-predefined namespace: xmldb :)

import module
    namespace lib-util="http://www.cagrid.org/xquery/library/util"
    at "../library/m-lib-util.xquery";

import module namespace
   administered-item="http://www.cagrid.org/xquery/library/administered-item"
   at "../library/m-administered-item.xquery";

import module
    namespace lib-rendering="http://www.cagrid.org/xquery/library/rendering"
    at "../web/m-lib-rendering.xquery";

import module namespace
    lib-uri-resolution="http://www.cagrid.org/xquery/library/resolver"
    at "../resolver/m-lib-uri-resolution.xquery";

declare function local:content($administered_item) as element(div)
{

{
      (if ($administered_item//openMDR:reference_uri)
      then (

Object Class Specific Attributes

             {
             for $reference_uris in $administered_item//openMDR:reference_uri
             let $reference_uri := data($reference_uris//openMDR:reference_uri)
             return

Reference URI	{lib-uri-resolution:html-anchor($reference_uri)}

             }

      )
      else (

Object Class Specific Attributes

reference URI or relationships undefined

      ),
      lib-rendering:render_administered_item($administered_item))

   }

};

declare option exist:serialize "media-type=text/html method=xhtml doctype-public=-//W3C//DTD XHTML 1.0 Transitional//EN doctype-system=http://www.w3.org/TR/2002/REC-xhtml1-20020801/DTD/xhtml1-transitional.dtd";

session:create(),
   let $compound_id := request:get-parameter("compound_id", "")
   let $administered_item := lib-util:mdrElement("object_class",$compound_id)
   let $title:=concat('Object class: ',administered-item:preferred-name($administered_item))
   return
      if (request:get-parameter("as-xml",()))
      then (lib-rendering:as-xml($administered_item))
      else(lib-rendering:txfrm-webpage($title, local:content($administered_item), true(), true(), $compound_id, 'object_class.xquery''../edit/editObjectClass.xquery'))