MarkLogic: Fix reporting values passed to internal errors.

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

import module namespace sem = "http://marklogic.com/semantics" at "/MarkLogic/semantics.xqy";

declare namespace o = "http://reecedunn.co.uk/xquery/options";
declare option o:implementation "marklogic/6.0";

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

declare variable $mode as xs:string external;
declare variable $mimetype as xs:string external;
declare variable $module-path as xs:string external;
declare variable $query as xs:string external;
declare variable $vars as xs:string external;
declare variable $types as xs:string external;
declare variable $context-value as xs:string external;
declare variable $context-path as xs:string external;
declare variable $rdf-output-format as xs:string external;
declare variable $updating as xs:string external;
declare variable $server as xs:string external;
declare variable $database as xs:string external;
declare variable $module-root as xs:string external;

declare function local:nullize($value) {
    if (string-length($value) eq 0) then () else $value
};

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

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

declare function local:item($path as xs:string, $value as xs:string, $type as xs:string) {
    if (string-length($value) ne 0) then
        xdmp:unquote($value)
    else if (string-length($path) ne 0) then
        doc($path)
    else
        ()
};

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

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

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

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

declare function local:rdf-format($mimetype) {
    switch ($mimetype)
    case "application/n-quads" return "nquad"
    case "application/n-triples" return "ntriple"
    case "application/rdf+json" return "rdfjson"
    case "application/rdf+xml" return "rdfxml"
    case "application/trig" return "trig"
    case "application/vnd.marklogic.triples+xml" return "triplexml"
    case "text/n3" return "n3"
    case "text/turtle" return "turtle"
    default return fn:error("UNSUPPORTED-RDF-FORMAT", "Unsupported RDF format: " || $mimetype)
};

declare function local:eval-options() {
    let $server := local:nullize($server) ! xdmp:server(.)
    let $database := local:nullize($database) ! xdmp:database(.)
    return <options xmlns="xdmp:eval">{
        if (exists($database)) then
            <database>{$database}</database>
        else
            (),
        if (exists($server)) then
            <default-collation>{xdmp:server-collation($server)}</default-collation>
        else
            (),
        let $server-coordinate-system := local:function("xdmp:server-coordinate-system#1")
        return if (exists($server) and exists($server-coordinate-system)) then
            <default-coordinate-system>{$server-coordinate-system($server)}</default-coordinate-system>
        else
            (),
        if (exists($server)) then
            <default-xquery-version>{xdmp:server-default-xquery-version($server)}</default-xquery-version>
        else
            (),
        if (exists($server)) then
            <modules>{xdmp:server-modules-database($server)}</modules>
        else
            <modules>0</modules> (: file system :),
        if (exists($server) or string-length($module-root) ne 0) then
            <root>{(local:nullize($module-root), xdmp:server-root($server))[1]}</root>
        else
            (),
        <update>{$updating}</update>
    }</options>
};

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

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

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

declare function local:sparql-update() as item()* {
    let $variables := local:parse-vars-map(xdmp:unquote($vars), xdmp:unquote($types))
    let $query :=
        if (string-length($query) ne 0) then
            $query
        else
            () (: TODO: Read the contents of the query file from the modules database. :)
    return if (local:version() < 8.0) then
        fn:error(
            xs:QName("UNSUPPORTED-VERSION"),
            "MarkLogic " || xdmp:version() || " does not support SPARQL update queries"
        )
    else switch ($mode)
    case "run" return sem:sparql-update($query, $variables)
    default return ()
};

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

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

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

try {
    let $retvals :=
        switch ($mimetype)
        case "application/sparql-query" return local:sparql-query()
        case "application/sparql-update" return local:sparql-update()
        case "application/sql" return local:sql()
        case "application/vnd.marklogic-javascript" return local:javascript()
        case "application/xquery" return local:xquery()
        case "application/xslt+xml" return local:xslt()
        default return ()
    let $triples := for $item in $retvals where $item instance of sem:triple return $item
    let $retvals := for $item in $retvals where not($item instance of sem:triple) return $item
    return if (exists($triples) and $rdf-output-format ne "") then
        let $rdf-output := sem:rdf-serialize($triples, local:rdf-format($rdf-output-format))
        let $_ := xdmp:add-response-header("X-Content-Type-" || (count($retvals) + 1), $rdf-output-format)
        return (
            for $retval at $i in $retvals
            let $_ := local:derived-type-name($retval) ! xdmp:add-response-header("X-Derived-" || $i, .)
            return $retval,
            $rdf-output
        )
    else
        for $retval at $i in ($retvals, $triples)
        let $_ := local:derived-type-name($retval) ! xdmp:add-response-header("X-Derived-" || $i, .)
        return $retval
} catch * {
    let $_ := xdmp:add-response-header("X-Derived-1", "err:error")
    return local:error($err:code, $err:description, $err:value, $err:module, $err:line-number, $err:column-number, $err:additional)
}

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

import module namespace sem = "http://marklogic.com/semantics" at "/MarkLogic/semantics.xqy";

declare namespace o = "http://reecedunn.co.uk/xquery/options";
declare option o:implementation "marklogic/6.0";

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

declare variable $mode as xs:string external;
declare variable $mimetype as xs:string external;
declare variable $module-path as xs:string external;
declare variable $query as xs:string external;
declare variable $vars as xs:string external;
declare variable $types as xs:string external;
declare variable $context-value as xs:string external;
declare variable $context-path as xs:string external;
declare variable $rdf-output-format as xs:string external;
declare variable $updating as xs:string external;
declare variable $server as xs:string external;
declare variable $database as xs:string external;
declare variable $module-root as xs:string external;

declare function local:nullize($value) {
    if (string-length($value) eq 0) then () else $value
};

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

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

declare function local:item($path as xs:string, $value as xs:string, $type as xs:string) {
    if (string-length($value) ne 0) then
        xdmp:unquote($value)
    else if (string-length($path) ne 0) then
        doc($path)
    else
        ()
};

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

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

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

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

declare function local:rdf-format($mimetype) {
    switch ($mimetype)
    case "application/n-quads" return "nquad"
    case "application/n-triples" return "ntriple"
    case "application/rdf+json" return "rdfjson"
    case "application/rdf+xml" return "rdfxml"
    case "application/trig" return "trig"
    case "application/vnd.marklogic.triples+xml" return "triplexml"
    case "text/n3" return "n3"
    case "text/turtle" return "turtle"
    default return fn:error("UNSUPPORTED-RDF-FORMAT", "Unsupported RDF format: " || $mimetype)
};

declare function local:eval-options() {
    let $server := local:nullize($server) ! xdmp:server(.)
    let $database := local:nullize($database) ! xdmp:database(.)
    return <options xmlns="xdmp:eval">{
        if (exists($database)) then
            <database>{$database}</database>
        else
            (),
        if (exists($server)) then
            <default-collation>{xdmp:server-collation($server)}</default-collation>
        else
            (),
        let $server-coordinate-system := local:function("xdmp:server-coordinate-system#1")
        return if (exists($server) and exists($server-coordinate-system)) then
            <default-coordinate-system>{$server-coordinate-system($server)}</default-coordinate-system>
        else
            (),
        if (exists($server)) then
            <default-xquery-version>{xdmp:server-default-xquery-version($server)}</default-xquery-version>
        else
            (),
        if (exists($server)) then
            <modules>{xdmp:server-modules-database($server)}</modules>
        else
            <modules>0</modules> (: file system :),
        if (exists($server) or string-length($module-root) ne 0) then
            <root>{(local:nullize($module-root), xdmp:server-root($server))[1]}</root>
        else
            (),
        <update>{$updating}</update>
    }</options>
};

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

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

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

declare function local:sparql-update() as item()* {
    let $variables := local:parse-vars-map(xdmp:unquote($vars), xdmp:unquote($types))
    let $query :=
        if (string-length($query) ne 0) then
            $query
        else
            () (: TODO: Read the contents of the query file from the modules database. :)
    return if (local:version() < 8.0) then
        fn:error(
            xs:QName("UNSUPPORTED-VERSION"),
            "MarkLogic " || xdmp:version() || " does not support SPARQL update queries"
        )
    else switch ($mode)
    case "run" return sem:sparql-update($query, $variables)
    default return ()
};

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

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

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

try {
    let $retvals :=
        switch ($mimetype)
        case "application/sparql-query" return local:sparql-query()
        case "application/sparql-update" return local:sparql-update()
        case "application/sql" return local:sql()
        case "application/vnd.marklogic-javascript" return local:javascript()
        case "application/xquery" return local:xquery()
        case "application/xslt+xml" return local:xslt()
        default return ()
    let $triples := for $item in $retvals where $item instance of sem:triple return $item
    let $retvals := for $item in $retvals where not($item instance of sem:triple) return $item
    return if (exists($triples) and $rdf-output-format ne "") then
        let $rdf-output := sem:rdf-serialize($triples, local:rdf-format($rdf-output-format))
        let $_ := xdmp:add-response-header("X-Content-Type-" || (count($retvals) + 1), $rdf-output-format)
        return (
            for $retval at $i in $retvals
            let $_ := local:derived-type-name($retval) ! xdmp:add-response-header("X-Derived-" || $i, .)
            return $retval,
            $rdf-output
        )
    else
        for $retval at $i in ($retvals, $triples)
        let $_ := local:derived-type-name($retval) ! xdmp:add-response-header("X-Derived-" || $i, .)
        return $retval
} catch * {
    let $_ := xdmp:add-response-header("X-Derived-1", "err:error")
    return local:error($err:code, $err:description, $err:value, $err:module, $err:line-number, $err:column-number, $err:additional)
}


[ignore] form action still pointed to "functions.xq" instead of "functions.xql"

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

(:~
    Search the built-in function library
:)
xquery version "1.0";
(: $Id: functions.xq 8359 2008-12-03 20:31:47Z wolfgang_m $ :)

declare namespace xqdoc="http://www.xqdoc.org/1.0";

import module namespace util="http://exist-db.org/xquery/util";
import module namespace request="http://exist-db.org/xquery/request";
import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace ngram="http://exist-db.org/xquery/ngram" at
    "java:org.exist.xquery.modules.ngram.NGramModule";

import module namespace setup="http://exist-db.org/xquery/docs/setup" at "../docsetup.xql";

declare option exist:serialize "media-type=text/xml";
(:~
    Execute a query or list all functions in a given module.
:)
declare function xqdoc:do-query($action as xs:string, $module as xs:string?, $type as xs:string?,
$qs as xs:string?, $print as xs:boolean) as element()* {
    if ($qs != '' or $module != '') then
        let $matches :=
            if ($action eq "Browse") then
                if( $module eq "All" ) then
                    /xqdoc:xqdoc//xqdoc:function
                else
                    /xqdoc:xqdoc[xqdoc:module/xqdoc:uri = $module]//xqdoc:function
            else if( $qs != '' ) then
                if ($type eq "name") then
                    //xqdoc:function[ngram:contains(xqdoc:name, $qs)]
                else
                    //xqdoc:function[ngram:contains(xqdoc:comment/xqdoc:description, $qs)]
            else ()

        let $hideIndicator   := if( $print ) then "" else "-"

        let $hideshowButtons := if( $print ) then ()
                                else

                                                    Modules:  Show All | Hide All

                                                    Function Descriptions: Show All | Hide All

        let $return :=
            for $modURI in distinct-values( $matches/ancestor::xqdoc:xqdoc/xqdoc:module/xqdoc:uri )
            order by $modURI
            return

                            { $modURI }
                            {  /xqdoc:xqdoc/xqdoc:module[ xqdoc:uri = $modURI ]/xqdoc:comment/xqdoc:description/text() }
                            { $hideIndicator }

                        {
                            for $match in $matches[ ancestor::xqdoc:xqdoc/xqdoc:module/xqdoc:uri = $modURI ]
                            order by $match/xqdoc:name
                            return

                                        {$match/ancestor::xqdoc:xqdoc/xqdoc:module/xqdoc:uri/text()}

{$match/xqdoc:name/text()}

{$match/xqdoc:signature/text()}

{$match/xqdoc:comment/xqdoc:description/text()}

                        }

        return
{ $hideshowButtons, $return }

    else
        ()
};

(:~
    Return the main XML page, which will be transformed into HTML by Cocoon.
    If Javascript is enabled on the client, this function will only be called
    once. All subsequent calls to this script will be made via AJAX and we don't
    need to return the entire page.
:)
declare function xqdoc:get-page($action as xs:string, $module as xs:string?, $type as xs:string?,
$query as xs:string?, $askPass as xs:boolean) as element() {
    <book>
        <bookinfo>
            <graphic fileref="logo.jpg"/>

            <productname>Open Source Native XML Database</productname>
            <title>XQuery Function Documentation</title>
            <link rel="stylesheet" type="text/css" href="styles/fundocs.css"/>
            <link rel="shortcut icon" href="../resources/exist_icon_16x16.ico"/>
			<link rel="icon" href="../resources/exist_icon_16x16.png" type="image/png"/>


Lemmas.

Lemmas.

declare variable $pos := //parts-of-speech;
declare variable $morph := //morphology;

declare function local:morph-description($tag, $category)
{
   $morph/field[@tag=$category]/value[@tag=$tag]/@summary ! string(.)
};

declare function local:number($morph as xs:string)
{
  let $tag := substring($morph,2,1)
  where $tag != "-"
  return
    attribute number {
      local:morph-description($tag, "number")
    }
};

declare function local:person($morph as xs:string)
{
  let $tag := substring($morph,1,1)
  where $tag != "-"
  return
    attribute person {
      tokenize(local:morph-description($tag, "person"))[1]
    }
};

declare function local:gender($morph as xs:string)
{
  let $tag := substring($morph,6,1)
  where $tag != "-"
  return
    attribute gender {
      local:morph-description($tag,"gender")
    }
};

declare function local:case($morph as xs:string)
{
  let $tag := substring($morph,7,1)
  where $tag != "-"
  return
    attribute case {
      local:morph-description($tag,"case")
    }
};

declare function local:tense($morph as xs:string)
{
  let $tag := substring($morph,3,1)
  where $tag != "-"
  return
    attribute tense {
      local:morph-description($tag,"tense")
    }
};

declare function local:voice($morph as xs:string)
{
  let $tag := substring($morph,5,1)
  where $tag != "-"
  return
    attribute voice {
      local:morph-description($tag,"voice")
    }
};

declare function local:mood($morph as xs:string)
{
  let $tag := substring($morph,4,1)
  where $tag != "-"
  return
    attribute mood {
      local:morph-description($tag,"mood")
    }
};

declare function local:degree($morph as xs:string)
{
  let $tag := substring($morph,8,1)
  where $tag != "-"
  return
    attribute degree {
      local:morph-description($tag,"degree")
    }
};

declare function local:strength($morph as xs:string)
{
  let $tag := substring($morph,9,1)
  where $tag != "-"
  return
    attribute strength {
      local:morph-description($tag,"strength")
    }
};

declare function local:inflection($morph as xs:string)
{
  let $tag := substring($morph,10,1)
  where $tag != "-"
  return
    attribute inflection {
      local:morph-description($tag,"inflection")
    }
};

declare function local:morphology($t)
{
  let $morph := string($t/@morphology)
  where $morph
  return (
    $t/@lemma,
    local:number($morph),
    local:person($morph),
    local:gender($morph),
    local:case($morph),
    local:tense($morph),
    local:voice($morph),
    local:mood($morph),
    local:degree($morph),
    local:strength($morph),
    local:inflection($morph)
  )
};

declare function local:class($t)
{
  let $description :=  string($pos/value[@tag = $t/@part-of-speech]/@summary)
  let $class :=
    switch ($description)
      case "interrogative adverb" return "adverb"
      case "relative adverb" return "adverb"
      case "common noun" return "noun"
      case "proper noun" return "noun"
      case "cardinal numeral" return "numeral"
      case "ordinal numeral" return "numeral"
      case "demonstrative pronoun" return "pronoun"
      case "indefinite pronoun" return "pronoun"
      case "interrogative pronoun" return "pronoun"
      case "relative pronoun" return "pronoun"
      case "personal pronoun" return "pronoun"
      case "personal reflexive pronoun" return "pronoun"
      case "possessive pronoun" return "pronoun"
      case "possessive reflexive pronoun" return "pronoun"
      case "reciprocal pronoun" return "pronoun"
      case "" return ()
      default return $description
  let $type :=
    switch ($description)
      case "interrogative adverb" return "interrogative"
      case "relative adverb" return "relative"
      case "common noun" return "common"
      case "proper noun" return "proper"
      case "cardinal numeral" return "cardinal"
      case "ordinal numeral" return "ordinal"
      case "demonstrative pronoun" return "demonstrative"
      case "indefinite pronoun" return "indefinite"
      case "interrogative pronoun" return "interrogative"
      case "relative pronoun" return "relative"
      case "personal pronoun" return "personal"
      case "personal reflexive pronoun" return "personal relative"
      case "possessive pronoun" return "possessive"
      case "possessive reflexive pronoun" return "possessive reflexive"
      case "reciprocal pronoun" return "reciprocal"
      default return ()
  return
    (
      $class ! attribute class {$class},
      $type ! attribute type {$type}
    )
};

declare function local:token($t)
{
  <w>
    {
      local:class($t),
      attribute role {$t/@relation},
      local:morphology($t),
      attribute id {$t/@id},
      $t/@head-id ! attribute head-id {$t/@head-id }
    }
    {
      string($t/@form)
    }
  </w>,
  $t/@presentation-after[. != ' '] ! <pc>{string(.)}</pc>
};

declare function local:unwrap($t, $stok)
{
  let $children :=  $stok[@head-id = $t/@id]
  let $seq := ($children | $t)/.
  return
    if ($children)
    then
      <wg role="{$t/@relation}" head="{$t/@id}">
        {
          for $s in $seq
          return
            if ($s is $t)
            then local:token($t)
            else local:unwrap($s, $stok)
        }
      </wg>
    else local:token($t)
};

declare function local:sentence($s)
{
  <sentence>
    {
      attribute id { $s/@id }
    }
    {
      let $stok := $s//token
      for $t in $stok[not(@head-id)]
      return local:unwrap($t, $stok)
    }
  </sentence>
};

<?xml-stylesheet href="treedown.css"?>,
<?xml-stylesheet href="boxwood.css"?>,
<book>
  {
    for $s in //sentence
    return local:sentence($s)
  }
</book>

declare variable $pos := //parts-of-speech;
declare variable $morph := //morphology;

declare function local:morph-description($tag, $category)
{
   $morph/field[@tag=$category]/value[@tag=$tag]/@summary ! string(.)
};

declare function local:number($morph as xs:string)
{
  let $tag := substring($morph,2,1)
  where $tag != "-"
  return
    attribute number {
      local:morph-description($tag, "number")
    }
};

declare function local:person($morph as xs:string)
{
  let $tag := substring($morph,1,1)
  where $tag != "-"
  return
    attribute person {
      tokenize(local:morph-description($tag, "person"))[1]
    }
};

declare function local:gender($morph as xs:string)
{
  let $tag := substring($morph,6,1)
  where $tag != "-"
  return
    attribute gender {
      local:morph-description($tag,"gender")
    }
};

declare function local:case($morph as xs:string)
{
  let $tag := substring($morph,7,1)
  where $tag != "-"
  return
    attribute case {
      local:morph-description($tag,"case")
    }
};

declare function local:tense($morph as xs:string)
{
  let $tag := substring($morph,3,1)
  where $tag != "-"
  return
    attribute tense {
      local:morph-description($tag,"tense")
    }
};

declare function local:voice($morph as xs:string)
{
  let $tag := substring($morph,5,1)
  where $tag != "-"
  return
    attribute voice {
      local:morph-description($tag,"voice")
    }
};

declare function local:mood($morph as xs:string)
{
  let $tag := substring($morph,4,1)
  where $tag != "-"
  return
    attribute mood {
      local:morph-description($tag,"mood")
    }
};

declare function local:degree($morph as xs:string)
{
  let $tag := substring($morph,8,1)
  where $tag != "-"
  return
    attribute degree {
      local:morph-description($tag,"degree")
    }
};

declare function local:strength($morph as xs:string)
{
  let $tag := substring($morph,9,1)
  where $tag != "-"
  return
    attribute strength {
      local:morph-description($tag,"strength")
    }
};

declare function local:inflection($morph as xs:string)
{
  let $tag := substring($morph,10,1)
  where $tag != "-"
  return
    attribute inflection {
      local:morph-description($tag,"inflection")
    }
};

declare function local:morphology($t)
{
  let $morph := string($t/@morphology)
  where $morph
  return (
    local:number($morph),
    local:person($morph),
    local:gender($morph),
    local:case($morph),
    local:tense($morph),
    local:voice($morph),
    local:mood($morph),
    local:degree($morph),
    local:strength($morph),
    local:inflection($morph)
  )
};

declare function local:class($t)
{
  let $description :=  string($pos/value[@tag = $t/@part-of-speech]/@summary)
  let $class :=
    switch ($description)
      case "interrogative adverb" return "adverb"
      case "relative adverb" return "adverb"
      case "common noun" return "noun"
      case "proper noun" return "noun"
      case "cardinal numeral" return "numeral"
      case "ordinal numeral" return "numeral"
      case "demonstrative pronoun" return "pronoun"
      case "indefinite pronoun" return "pronoun"
      case "interrogative pronoun" return "pronoun"
      case "relative pronoun" return "pronoun"
      case "personal pronoun" return "pronoun"
      case "personal reflexive pronoun" return "pronoun"
      case "possessive pronoun" return "pronoun"
      case "possessive reflexive pronoun" return "pronoun"
      case "reciprocal pronoun" return "pronoun"
      case "" return ()
      default return $description
  let $type :=
    switch ($description)
      case "interrogative adverb" return "interrogative"
      case "relative adverb" return "relative"
      case "common noun" return "common"
      case "proper noun" return "proper"
      case "cardinal numeral" return "cardinal"
      case "ordinal numeral" return "ordinal"
      case "demonstrative pronoun" return "demonstrative"
      case "indefinite pronoun" return "indefinite"
      case "interrogative pronoun" return "interrogative"
      case "relative pronoun" return "relative"
      case "personal pronoun" return "personal"
      case "personal reflexive pronoun" return "personal relative"
      case "possessive pronoun" return "possessive"
      case "possessive reflexive pronoun" return "possessive reflexive"
      case "reciprocal pronoun" return "reciprocal"
      default return ()
  return
    (
      $class ! attribute class {$class},
      $type ! attribute type {$type}
    )
};

declare function local:token($t)
{
  <w>
    {
      local:class($t),
      attribute role {$t/@relation},
      local:morphology($t),
      attribute id {$t/@id},
      $t/@head-id ! attribute head-id {$t/@head-id }
    }
    {
      string($t/@form)
    }
  </w>,
  $t/@presentation-after[. != ' '] ! <pc>{string(.)}</pc>
};

declare function local:unwrap($t, $stok)
{
  let $children :=  $stok[@head-id = $t/@id]
  let $seq := ($children | $t)/.
  return
    if ($children)
    then
      <wg role="{$t/@relation}" head="{$t/@id}">
        {
          for $s in $seq
          return
            if ($s is $t)
            then local:token($t)
            else local:unwrap($s, $stok)
        }
      </wg>
    else local:token($t)
};

declare function local:sentence($s)
{
  <sentence>
    {
      attribute id { $s/@id }
    }
    {
      let $stok := $s//token
      for $t in $stok[not(@head-id)]
      return local:unwrap($t, $stok)
    }
  </sentence>
};

<?xml-stylesheet href="treedown.css"?>,
<?xml-stylesheet href="boxwood.css"?>,
<book>
  {
    for $s in //sentence
    return local:sentence($s)
  }
</book>


added hits to the output

added hits to the output

xquery version "1.0";

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

    let $rel-label := ' ppm'
    let $lb := "
"
    let $percentile-base :=1000000
    let $decimal-base := 100
    let $all-label := '_all_'
    let $store := true()
    let $output-dir := "/db/apps/testing/"
    let $output-file := "VWB-lemmas_onAMC_all.dataset.xml"
      (: let $data := subsequence(collection("/db/apps/cr/modules/testing/results/corpus207-solr4-8985"),1,20)   :)
    let $data := collection("/db/apps/cr/modules/testing/results/corpus207-solr4-8985")

    (: let $data := collection("/db/cr/modules/testing/results/local-solr4")      :)

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

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

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

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

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

  (:  let $labels := for $l in ('lemma', 'records', 'hits', 'freq', $facet-labels)   :)
        let $labels := <labels>{$all-label}{for $l in  $facet-labels
                        return {$l}
                        }</labels>

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

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

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

    let $result := <dataset>{($labels,$dataseries)}</dataset>

    return  if ($store) then
                    xmldb:store($output-dir,$output-file,$result)
                else
                    $result

xquery version "1.0";

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

    let $rel-label := ' ppm'
    let $lb := "
"
    let $percentile-base :=1000000
    let $decimal-base := 100
    let $all-label := '_all_'
    let $store := true()
    let $output-dir := "/db/apps/testing/"
    let $output-file := "VWB-lemmas_onAMC_all.dataset.xml"
      (: let $data := subsequence(collection("/db/apps/cr/modules/testing/results/corpus207-solr4-8985"),1,20)   :)
    let $data := collection("/db/apps/cr/modules/testing/results/corpus207-solr4-8985")

    (: let $data := collection("/db/cr/modules/testing/results/local-solr4")      :)

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

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

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

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

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

  (:  let $labels := for $l in ('lemma', 'records', 'hits', 'freq', $facet-labels)   :)
        let $labels := <labels>{$all-label}{for $l in  $facet-labels
                        return {$l}
                        }</labels>

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

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

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

    let $result := <dataset>{($labels,$dataseries)}</dataset>

    return  if ($store) then
                    xmldb:store($output-dir,$output-file,$result)
                else
                    $result


Improved XQTS results.
Unfortunately, standard stylesheets are unable to cope with everything :
http://www.w3.org/Bugs/Public/show_bug.cgi?id=5217

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

xquery version "1.0";
(: $Id$ :)
declare namespace response="http://exist-db.org/xquery/response";
declare namespace catalog="http://www.w3.org/2005/02/query-test-XQTSCatalog";
declare namespace hack="http://exist-db.org/xquery/xqts/hacked-test-cases";
declare option exist:serialize "method=xml indent=yes";
declare option exist:output-size-limit "-1";

let $product-version := util:system-property("product-version")
let $product-build := util:system-property("product-build")
let $revision := system:get-revision()
let $test-suite := doc('/db/XQTS/XQTSCatalog.xml')/catalog:test-suite/@version
let $dummy := response:set-header("Content-Disposition", concat(
	"attachment; filename="results_XQTS-" , $test-suite , "_eXist-" ,
	$product-version , '_' , $product-build , ".xml"" ) )

let $cases := fn:collection(  '/db/XQTS' )//test-case
return
<test-suite-result xmlns="http://www.w3.org/2005/02/query-test-XQTSResult">
    <implementation name="eXist-db" version="{$product-version} (revision {$revision} {$product-build})" anonymous-result-column="false">

        <organization name="eXist Open Source Native XML database"  website="http://www.exist-db.org" anonymous="false"/>

        <submittor name="eXist XQTS testsuite runner" email="eXistAdmin@gmail.com"/>

        <description>

eXist is an Open Source native XML database featuring efficient,
                index-based XQuery processing, automatic indexing, extensions for full-text
                search,  XUpdate  support and tight integration with existing XML development tools.

        </description>

        <implementation-defined-items>

        </implementation-defined-items>

        <features>

        <feature name="Minimal Conformance" supported="true"/>
        <feature name="Schema Import" supported="false"/>
        <feature name="Schema Validation" supported="false"/>
        <feature name="Static Typing" supported="false"/>
        <feature name="Static Typing Extensions" supported="false"/>
        <feature name="Full Axis" supported="true"/>
        <feature name="Module" supported="true"/>
        <feature name="Serialization" supported="true"/>
        <feature name="Trivial XML Embedding" supported="false"/>
				  </features>

        <context-properties>
      <context-property name="Statically known namespaces" context-type="static"
      value="XQuery default augmented with xmlns:exist='http://exist.sourceforge.net/NS/exist' (unbound when the XQTS is run)"/>
      <context-property name="Default element/type namespace" context-type="static" value="XQuery default"/>
      <context-property name="Default function namespace" context-type="static"
      value="'http://www.w3.org/2005/xpath-functions' by default"/>
      <context-property name="In-scope schema types" context-type="static" value="N/A"/>
      <context-property name="In-scope element declarations" context-type="static" value="N/A"/>
      <context-property name="In-scope attribute declarations" context-type="static" value="N/A"/>
      <context-property name="In-scope variables" context-type="static" value="None"/>
      <context-property name="Context item static type" context-type="static" value="item()?"/>
      <context-property name="Function signatures" context-type="static" value="XQuery default"/>
      <context-property name="Statically known collations" context-type="static" value="See http://exist.sourceforge.net/xquery.html#N10676"/>
      <context-property name="Default collation" context-type="static" value="http://www.w3.org/2005/xpath-functions/collation/codepoint"/>
      <context-property name="Construction mode" context-type="static"/>
      <context-property name="Ordering mode" context-type="static"/>
      <context-property name="Default order for empty sequences" context-type="static"/>
      <context-property name="Boundary-space policy" context-type="static"/>
      <context-property name="Copy-namespaces mode" context-type="static"/>
      <context-property name="Base URI" context-type="static" value="'/db' by default"/>
      <context-property name="Statically known documents" context-type="static" value="By default, all the documents stored in the database for which the user has required permissions"/>
      <context-property name="Statically known collections" context-type="static" value="By default, all the collections stored in the database for which the user has required permissions"/>
      <context-property name="Statically known default collection type" context-type="static"/>
      <context-property name="Context item" context-type="dynamic"/>
      <context-property name="Context position" context-type="dynamic"/>
      <context-property name="Context size" context-type="dynamic"/>
      <context-property name="Variable values" context-type="dynamic"/>
      <context-property name="Function implementations" context-type="dynamic"/>
      <context-property name="Current dateTime" context-type="dynamic" value="Settable using an option, a pragma, or API"/>
      <context-property name="Implicit timezone" context-type="dynamic" value="Settable using an option, a pragma, or API"/>
      <context-property name="Available documents" context-type="dynamic" value="By default, all the documents stored in the database for which the user has required permissions + external URLs"/>
      <context-property name="Available collections" context-type="dynamic" value="By default, all the collections stored in the database for which the user has required permissions"/>
      <context-property name="Default collection" context-type="dynamic" value="By default, all the collections stored in the database for which the user has required permissions"/>
      <context-property name="expressionUnicode" context-type="static" value="UTF-8"/>
      <context-property name="collations" context-type="static" value="By default, 'http://www.w3.org/2005/xpath-functions/collation/codepoint'"/>
      <context-property name="implicitTimezone" context-type="static" value="By default, the system's one"/>
      <context-property name="errorsMethod" context-type="static" value="Errors are thrown as an org.exist.xquery.XPathException. The exception's getMessage() method contains the error code."/>
        </context-properties>

    </implementation>

    <syntax>XQuery</syntax>

    <test-run dateRun="{fn:current-dateTime()}">
        <test-suite version="{$test-suite}"/>
        <transformation>
        {
            if (empty(doc('/db/XQTS/hacked-tests.xml')/hack:test-cases/hack:test-case/hack:expected-result)) then

No unusual transformations.

            else

The following tests have been evaluated against results provided by other XQuery processors.
,
                (: this paragraph element is not really wanted but we want it to be processed by the XSLT :)

                    Test name	Reference software	Considered result
                    {
                        for $hackedTest in doc('/db/XQTS/hacked-tests.xml')/hack:test-cases/hack:test-case/hack:expected-result
                        return

                                {string($hackedTest/../@name)}
                                {string($hackedTest/@from)}
                                {string($hackedTest)}

                     }

        }
        </transformation>
        <comparison>
        {
            if (empty(doc('/db/XQTS/hacked-tests.xml')/hack:test-cases/hack:test-case/@compare)) then

No unusual comparisons

            else

The following tests have required a comparison method different from the standard one.
,
                (: this paragraph element is not really wanted but we want it to be processed by the XSLT :)

                    Test name	Comparison method
                    {
                        for $hackedTest in doc('/db/XQTS/hacked-tests.xml')/hack:test-cases/hack:test-case[@compare]
                        return

                                {string($hackedTest/@name)}
                                {string($hackedTest/@compare)}

                     }

,

UnnormalizedText : result text nodes are concatenated without introducing (normalized) spaces between them.
,

TextAsXML : result string is evaluated as if it were XML, then an XML comparison is done.

        }
        </comparison>
        <otherComments>

The test run took {let $b := for $a in $cases//@dateRun return xs:time($a)
return (max($b) - min($b)) div xs:dayTimeDuration('PT1S')} seconds.

        </otherComments>
    </test-run>

{
    for $case in $cases
    order by $case/@name
    return <test-case name="{$case/@name}" result="{$case/@result}" />
}
</test-suite-result>

xquery version "1.0";
(: $Id$ :)
declare namespace response="http://exist-db.org/xquery/response";
declare namespace catalog="http://www.w3.org/2005/02/query-test-XQTSCatalog";
declare namespace hack="http://exist-db.org/xquery/xqts/hacked-test-cases";
declare option exist:serialize "method=xml indent=yes";
declare option exist:output-size-limit "-1";

let $product-version := util:system-property("product-version")
let $product-build := util:system-property("product-build")
let $revision := system:get-revision()
let $test-suite := doc('/db/XQTS/XQTSCatalog.xml')/catalog:test-suite/@version
let $dummy := response:set-header("Content-Disposition", concat(
	"attachment; filename="results_XQTS-" , $test-suite , "_eXist-" ,
	$product-version , '_' , $product-build , ".xml"" ) )

let $cases := fn:collection(  '/db/XQTS' )//test-case
return
<test-suite-result xmlns="http://www.w3.org/2005/02/query-test-XQTSResult">
    <implementation name="eXist-db" version="{$product-version} (revision {$revision} {$product-build})" anonymous-result-column="false">

        <organization name="eXist Open Source Native XML database"  website="http://www.exist-db.org" anonymous="false"/>

        <submittor name="eXist XQTS testsuite runner" email="eXistAdmin@gmail.com"/>

        <description>

eXist is an Open Source native XML database featuring efficient,
                index-based XQuery processing, automatic indexing, extensions for full-text
                search,  XUpdate  support and tight integration with existing XML development tools.

        </description>

        <implementation-defined-items>

        </implementation-defined-items>

        <features>

        <feature name="Minimal Conformance" supported="true"/>
        <feature name="Schema Import" supported="false"/>
        <feature name="Schema Validation" supported="false"/>
        <feature name="Static Typing" supported="false"/>
        <feature name="Static Typing Extensions" supported="false"/>
        <feature name="Full Axis" supported="true"/>
        <feature name="Module" supported="true"/>
        <feature name="Serialization" supported="true"/>
        <feature name="Trivial XML Embedding" supported="false"/>
				  </features>

        <context-properties>
      <context-property name="Statically known namespaces" context-type="static"
      value="XQuery default augmented with xmlns:exist='http://exist.sourceforge.net/NS/exist' (unbound when the XQTS is run)"/>
      <context-property name="Default element/type namespace" context-type="static" value="XQuery default"/>
      <context-property name="Default function namespace" context-type="static"
      value="'http://www.w3.org/2005/xpath-functions' by default"/>
      <context-property name="In-scope schema types" context-type="static" value="N/A"/>
      <context-property name="In-scope element declarations" context-type="static" value="N/A"/>
      <context-property name="In-scope attribute declarations" context-type="static" value="N/A"/>
      <context-property name="In-scope variables" context-type="static" value="None"/>
      <context-property name="Context item static type" context-type="static" value="item()?"/>
      <context-property name="Function signatures" context-type="static" value="XQuery default"/>
      <context-property name="Statically known collations" context-type="static" value="See http://exist.sourceforge.net/xquery.html#N10676"/>
      <context-property name="Default collation" context-type="static" value="http://www.w3.org/2005/xpath-functions/collation/codepoint"/>
      <context-property name="Construction mode" context-type="static"/>
      <context-property name="Ordering mode" context-type="static"/>
      <context-property name="Default order for empty sequences" context-type="static"/>
      <context-property name="Boundary-space policy" context-type="static"/>
      <context-property name="Copy-namespaces mode" context-type="static"/>
      <context-property name="Base URI" context-type="static" value="'/db' by default"/>
      <context-property name="Statically known documents" context-type="static" value="all documents in the database by default"/>
      <context-property name="Statically known collections" context-type="static" value="all collections in the database by default"/>
      <context-property name="Statically known default collection type" context-type="static"/>
      <context-property name="Context item" context-type="dynamic"/>
      <context-property name="Context position" context-type="dynamic"/>
      <context-property name="Context size" context-type="dynamic"/>
      <context-property name="Variable values" context-type="dynamic"/>
      <context-property name="Function implementations" context-type="dynamic"/>
      <context-property name="Current dateTime" context-type="dynamic" value="Settable using an option, a pragma, or API"/>
      <context-property name="Implicit timezone" context-type="dynamic" value="Settable using an option, a pragma, or API"/>
      <context-property name="Available documents" context-type="dynamic" value="Any document in the database for which the user has required permissions + external URLs"/>
      <context-property name="Available collections" context-type="dynamic" value="Any collection in the database for which the user has required permissions"/>
      <context-property name="Default collection" context-type="dynamic" value="all collections"/>
        </context-properties>

    </implementation>

    <syntax>XQuery</syntax>

    <test-run dateRun="{fn:current-dateTime()}">
        <test-suite version="{$test-suite}"/>
        <transformation>
        {
            if (empty(doc('/db/XQTS/hacked-tests.xml')/hack:test-cases/hack:test-case/hack:expected-result)) then

No unusual transformations.

            else

The following tests have been evaluated against results provided by other XQuery processors.
,

                    Test name	Reference software	Considered result
                    {
                        for $hackedTest in doc('/db/XQTS/hacked-tests.xml')/hack:test-cases/hack:test-case/hack:expected-result
                        return

                                {string($hackedTest/../@name)}
                                {string($hackedTest/@from)}
                                {string($hackedTest)}

                     }

        }
        </transformation>
        <comparison>
        {
            if (empty(doc('/db/XQTS/hacked-tests.xml')/hack:test-cases/hack:test-case/@compare)) then

No unusual comparisons

            else

The following tests have required a comparison method different from the standard one.
,

                    Test name	Comparison method
                    {
                        for $hackedTest in doc('/db/XQTS/hacked-tests.xml')/hack:test-cases/hack:test-case[@compare]
                        return

                                {$hackedTest/@name}
                                {$hackedTest/@compare}

                     }

,

UnnormalizedText : result text nodes are concatenated without introducing (normalized) spaces between them.
,

TextAsXML : result string is evaluated as if it were XML, then an XML comparison is done.

        }
        </comparison>
        <otherComments>

The test run took {let $b := for $a in $cases//@dateRun return xs:time($a)
return (max($b) - min($b)) div xs:dayTimeDuration('PT1S')} seconds.

        </otherComments>
    </test-run>

{
    for $case in $cases
    order by $case/@name
    return <test-case name="{$case/@name}" result="{$case/@result}" />
}
</test-suite-result>


removed CVS test.

removed CVS test.

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

zorba-csv:parse(file:read-text(fn:resolve-uri("NAWQA.swmaster.CROSSTAB_COUNT.1260179451247.csv")),
                    <options>
                      <first-row-is-header/>
                      <csv separator=","
                           quote-char=""
                           quote-escape=""/>
                      <xml-nodes>
                        <row>
                          <column/>
                        </row>
                      </xml-nodes>
                    </options>
                    )


Update BaseX Update module.

Update BaseX Update module.

xquery version "3.1";
(:~
 : BaseX Update Module functions
 :
 : @see http://docs.basex.org/wiki/Update_Module
 :)
module namespace update = "http://basex.org/modules/update";

declare namespace a = "http://reecedunn.co.uk/xquery/annotations";
declare namespace o = "http://reecedunn.co.uk/xquery/options";

declare option o:requires "basex/9.0";

declare %a:since("basex", "9.0") function update:apply($function as function(*), $arguments as array(*)) as empty-sequence() external;
declare %a:since("basex", "9.0") function update:for-each($seq as item()*, $function as function(item()) as item()*) as empty-sequence() external;
declare %a:since("basex", "9.0") function update:for-each-pair($seq1 as item()*, $function as function(item()) as item()*) as empty-sequence() external;
declare %a:since("basex", "9.0") function update:map-for-each($map as map(*), $function as function(xs:anyAtomicType, item()*) as item()*) as item()* external;
declare %a:since("basex", "9.0") function update:output($result as item()*) as empty-sequence() external;
declare %a:since("basex", "9.0") function update:cache() as item()* external;
declare %a:since("basex", "9.3") function update:cache($reset as xs:boolean) as item() external;