MarkLogic: Fix running queries on versions prior to 8.0-7 and 9.0-2 that don't support the <update> option.

(:
 : 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:version-minor() {
    substring-after(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
            (),
        let $major := local:version()
        let $minor := local:version-minor()
        return if ($major lt 7.0 or ($major eq 8.0 and $minor lt 7.0) or ($major eq 9.0 and $minor lt 2.0) or $major gt 9.0) then
            if ($updating) then
                <transaction-mode>update</transaction-mode>
            else
                <transaction-mode>query</transaction-mode>
        else
            (: MarkLogic 8.0-7 and 9.0-2 support <update> :)
            <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: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)
}


Remove duplicate namespaces from MarkLogic 6.0.

xquery version "1.0";

(: http://docs.marklogic.com/6.0/guide/xquery/namespaces :)
import module namespace cts = "http://marklogic.com/cts" at "res://marklogic.com/cts.xqy";
declare namespace dav = "DAV:";
import module namespace dbg = "http://marklogic.com/xdmp/dbg" at "res://marklogic.com/xdmp/dbg.xqy";
declare namespace dir = "http://marklogic.com/xdmp/directory";
declare namespace err = "http://www.w3.org/2005/xqt-error";
declare namespace error = "http://marklogic.com/xdmp/error";
import module namespace fn = "http://www.w3.org/2005/xpath-functions" at "res://www.w3.org/2005/xpath-functions.xqy";
import module namespace json = "http://marklogic.com/xdmp/json" at "res://marklogic.com/xdmp/json.xqy";
declare namespace local = "http://www.w3.org/2005/xquery-local-functions";
declare namespace lock = "http://marklogic.com/xdmp/lock";
import module namespace map = "http://marklogic.com/xdmp/map" at "res://marklogic.com/xdmp/map.xqy";
import module namespace math = "http://marklogic.com/xdmp/math" at "res://marklogic.com/xdmp/math.xqy";
import module namespace prof = "http://marklogic.com/xdmp/profile" at "res://marklogic.com/xdmp/prof.xqy";
declare namespace prop = "http://marklogic.com/xdmp/property";
declare namespace sec = "http://marklogic.com/security";
import module namespace spell = "http://marklogic.com/xdmp/spell" at "res://marklogic.com/xdmp/spell.xqy";
import module namespace xdmp = "http://marklogic.com/xdmp" at "res://marklogic.com/xdmp.xqy";
declare namespace xml = "http://www.w3.org/XML/1998/namespace";
declare namespace xqe = "http://marklogic.com/xqe";
declare namespace xqterr = "http://www.w3.org/2005/xqt-error";
import module namespace xs = "http://www.w3.org/2001/XMLSchema" at "res://www.w3.org/2001/XMLSchema.xqy";
declare namespace xsi = "http://www.w3.org/2001/XMLSchema-instance";

()

xquery version "1.0";

(: http://docs.marklogic.com/6.0/guide/xquery/namespaces :)
import module namespace cts = "http://marklogic.com/cts" at "res://marklogic.com/cts.xqy";
declare namespace dav = "DAV:";
import module namespace dbg = "http://marklogic.com/xdmp/dbg" at "res://marklogic.com/xdmp/dbg.xqy";
declare namespace dir = "http://marklogic.com/xdmp/directory";
declare namespace err = "http://www.w3.org/2005/xqt-error";
declare namespace error = "http://marklogic.com/xdmp/error";
import module namespace fn = "http://www.w3.org/2005/xpath-functions" at "res://www.w3.org/2005/xpath-functions.xqy";
import module namespace json = "http://marklogic.com/xdmp/json" at "res://marklogic.com/xdmp/json.xqy";
declare namespace local = "http://www.w3.org/2005/xquery-local-functions";
declare namespace lock = "http://marklogic.com/xdmp/lock";
import module namespace map = "http://marklogic.com/xdmp/map" at "res://marklogic.com/xdmp/map.xqy";
import module namespace math = "http://marklogic.com/xdmp/math" at "res://marklogic.com/xdmp/math.xqy";
import module namespace math = "http://marklogic.com/xdmp/math" at "res://marklogic.com/xdmp/math.xqy";
import module namespace prof = "http://marklogic.com/xdmp/profile" at "res://marklogic.com/xdmp/prof.xqy";
declare namespace prop = "http://marklogic.com/xdmp/property";
declare namespace sec = "http://marklogic.com/security";
import module namespace spell = "http://marklogic.com/xdmp/spell" at "res://marklogic.com/xdmp/spell.xqy";
import module namespace xdmp = "http://marklogic.com/xdmp" at "res://marklogic.com/xdmp.xqy";
declare namespace xdmp = "http://marklogic.com/xdmp";
declare namespace xml = "http://www.w3.org/XML/1998/namespace";
declare namespace xqe = "http://marklogic.com/xqe";
declare namespace xqterr = "http://www.w3.org/2005/xqt-error";
import module namespace xs = "http://www.w3.org/2001/XMLSchema" at "res://www.w3.org/2001/XMLSchema.xqy";
declare namespace xsi = "http://www.w3.org/2001/XMLSchema-instance";

()


[apidoc] Support functions with multiple arity.

(:
 : Copyright (C) 2020 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 "3.1";

declare namespace apidoc = "http://marklogic.com/xdmp/apidoc";
declare namespace map = "http://www.w3.org/2005/xpath-functions/map";
declare namespace xhtml = "http://www.w3.org/1999/xhtml";

declare variable $language as xs:string external := "xquery"; (: xquery | javascript | rest :)
declare variable $namespace as xs:string external;
declare variable $local-name as xs:string external;

declare variable $apidoc as element(apidoc:apidoc) :=
    typeswitch (.)
    case xs:string return fn:parse-xml(.)/element()
    case document-node() return ./element()
    default return .;

declare function local:apidoc-language($doc as element()) as xs:string {
    ($doc/@class, "xquery")[1]
};

declare function local:prefix($namespaces as map(*), $namespace as xs:string) as xs:string {
    for $prefix in map:keys($namespaces)
    where map:get($namespaces, $prefix) = $namespace
    return $prefix
};

(: namespaces -------------------------------------------------------------- :)

declare variable $module-namespaces := map:merge(
    for $import in $apidoc//apidoc:module/apidoc:summary//(*:p|*:pre)
    let $match := fn:analyze-string(($import/*:code, $import)[1], "import module (namespace\s*([a-z0-9]+)\s*=\s*)?""([^""]+)""")/fn:match[1]
    let $prefix := $import/ancestor::apidoc:module/@lib
    let $namespace := $match/fn:group[@nr = "3"]/string()
    where exists($namespace)
    return map:entry($prefix, $namespace)
);

declare variable $xquery-namespaces := map {
    "local": "http://www.w3.org/2005/xquery-local-functions",
    "fn": "http://www.w3.org/2005/xpath-functions",
    "xml": "http://www.w3.org/XML/1998/namespace",
    "xs": "http://www.w3.org/2001/XMLSchema",
    "xsi": "http://www.w3.org/2001/XMLSchema-instance"
};

declare variable $marklogic-5-builtin := map {
    "cts": "http://marklogic.com/cts",
    "dbg": "http://marklogic.com/xdmp/dbg",
    "dir": "http://marklogic.com/xdmp/directory",
    "error": "http://marklogic.com/xdmp/error",
    "map": "http://marklogic.com/xdmp/map",
    "math": "http://marklogic.com/xdmp/math",
    "prof": "http://marklogic.com/xdmp/profile",
    "sec": "http://marklogic.com/security",
    "spell": "http://marklogic.com/xdmp/spell",
    "xdmp": "http://marklogic.com/xdmp"
};

declare variable $marklogic-6-builtin := map {
    "err": "http://www.w3.org/2005/xqt-error"
};

declare variable $marklogic-7-builtin := map {
    "rdf": "http://www.w3.org/1999/02/22-rdf-syntax-ns#",
    "sc": "http://marklogic.com/xdmp/schema-components",
    "sql": "http://marklogic.com/xdmp/sql"
};

declare variable $marklogic-10-builtin := map {
    "cntk": "http://marklogic.com/cntk",
    "ort": "http://marklogic.com/onnxruntime"
};

declare variable $marklogic-additional := map {
    "as": "http://marklogic.com/xdmp/assignments",
    "db": "http://marklogic.com/xdmp/database",
    "dg": "xdmp:document-get",
    "cl": "http://marklogic.com/xdmp/clusters",
    "exsl": "http://exslt.org/common",
    "extusr": "http://marklogic.com/xdmp/external/user",
    "gr": "http://marklogic.com/xdmp/group",
    "lang": "http://marklogic.com/xdmp/language",
    "list": "http://marklogic.com/manage/package/list",
    "md": "urn:oasis:names:tc:SAML:2.0:metadata",
    "mt": "http://marklogic.com/xdmp/mimetypes",
    "pkg": "http://marklogic.com/manage/package",
    "s": "http://www.w3.org/2009/xpath-functions/analyze-string",
    "sch": "http://purl.oclc.org/dsdl/schematron",
    "x509": "http://marklogic.com/xdmp/x509",
    "xdt": "http://www.w3.org/2004/10/xpath-datatypes",
    "xi": "http://www.w3.org/2001/XInclude"
};

declare variable $namespaces := map:merge((
    $module-namespaces,
    $xquery-namespaces,
    $marklogic-5-builtin,
    $marklogic-6-builtin,
    $marklogic-7-builtin,
    $marklogic-10-builtin,
    $marklogic-additional,
    ()
));

(: functions --------------------------------------------------------------- :)

(: Several functions in the apidocs have duplicate parameter names in some versions, so fix these. :)
declare variable $param-fixes := map {
    "fn:subtract-dateTimes-yielding-dayTimeDuration": ("srcval1", "srcval2"),
    "fn:subtract-dateTimes-yielding-yearMonthDuration": ("srcval1", "srcval2"),
    "geo:region-contains": ("target", "region", "options"),
    "math:fmod": ("x", "y"),
    "math:rank": ("arg1", "arg2", "options")
};

declare variable $functions as element(apidoc:function)* := $apidoc//apidoc:function[
    local:function-language(.) = $language and not(@name = "")
];

declare function local:function-language($function as element(apidoc:function)) as xs:string {
    let $bucket := $function/@bucket
    return switch ($bucket)
    case "REST Resources API" return "rest"
    default return local:apidoc-language($function)
};

declare function local:function-name($function as element(apidoc:function)) as xs:string {
    ``[`{$function/@lib}`:`{$function/@name}`]``
};

declare function local:function-parameters($function as element(apidoc:function)) as xs:string* {
    let $names as xs:string* :=
        let $names := map:get($param-fixes, local:function-name($function))
        return if (exists($names)) then
            $names
        else
            $function/apidoc:params/apidoc:param[local:apidoc-language(.) = $language]/@name/string()
    return if (count($names) != count(distinct-values($names))) then
        fn:error(xs:QName("err:XQST0039"),``[Duplicate parameter name in `{local:function-name($function)}`]``)
    else
        $names
};

declare function local:function-arity($function as element(apidoc:function)) as map(*) {
    let $params := $function/apidoc:params/apidoc:param[local:apidoc-language(.) = $language]
    return map {
        "min": count($params[not(@optional = "true")]),
        "max": count($params)
    }
};

declare function local:function-parameter($function as element(apidoc:function), $name as xs:string) as element(apidoc:param) {
    let $names := map:get($param-fixes, local:function-name($function))
    return if (exists($names)) then
        let $i := fn:index-of($names, $name)
        return $function/apidoc:params/apidoc:param[$i]
    else
        $function/apidoc:params/apidoc:param[@name = $name and local:apidoc-language(.) = $language]
};

declare function local:function-parameter-type($function as element(apidoc:function), $name as xs:string) as xs:string {
    let $type := local:function-parameter($function, $name)/@type/string()
    return switch ($type)
    case "atomic type" return "item()*"
    case "xs:string)" return "xs:string"
    case "xs:dateTime? | xs:date? | xs:string?" return "(xs:dateTime?|xs:date?|xs:string?)"
    case "binary())" return "binary()"
    case "element(sec:query-rolesets)*)" return "element(sec:query-rolesets)*"
    case "function()" return "function(*)"
    case "item()* | map:map" return "(item()*|map:map)"
    case "(binary()|node())*" return "(binary()*|node()*)"
    case "(binary()|node())?" return "(binary()?|node()?)"
    case "(element()|map:map)?" case "element()?|map:map?" return "(element()?|map:map?)"
    case "(node()? | map:map)?" return "(node()?|map:map?)"
    case "(cts:order|xs:string)*" return "(cts:order*|xs:string*)"
    case "[xs:string?]" return "xs:string?"
    default return replace($type, ",\.\.\.", "...")
};

declare function local:function-return-type($function as element(apidoc:function)) as xs:string {
    let $type := normalize-space($function/apidoc:return[local:apidoc-language(.) = $language])
    return switch ($type)
    case "An XML representation of the certificate." return "element()?"
    case "element())" case "Element()" return "element()"
    case "element()|map:map" return "(element()|map:map)"
    case "element(xsd:schema)*" return "element(xs:schema)*"
    case "empty-sequence" case "empty sequence" return "empty-sequence()"
    case "xs:string)" return "xs:string"
    case "xs:unsignedLong)" return "xs:unsignedLong"
    case "pkgins:install($pkgname)" return "element(pkg:install-status)"
    case "pkgins:revert($ticket)" return "element(pkg:revert-status)"
    case "query-results-serialize($results)" return "item()*"
    case "The return data type is the data type of the date argument" return "item()"
    case "" return
        switch (local:function-name($function))
        case "admin:appserver-set-output-indent-tabs" return "element(configuration)"
        default return ""
    default return $type
};

declare function local:function-xquery-signatures($function as element(apidoc:function)) as xs:string* {
    let $name := local:function-name($function)
    let $params :=
        for $name in local:function-parameters($function)
        let $type := local:function-parameter-type($function, $name)
        return ``[$`{$name}` as `{$type}`]``
    let $type := local:function-return-type($function)
    let $arity-range := local:function-arity($function)
    for $arity in $arity-range?min to $arity-range?max
    let $params := $params[position() = 1 to $arity]
    return if ($type = "") then
        ``[declare function `{$name}`(`{string-join($params, ", ")}`) external;]``
    else
        ``[declare function `{$name}`(`{string-join($params, ", ")}`) as `{$type}` external;]``
};

(: query ------------------------------------------------------------------- :)

let $prefix := local:prefix($namespaces, $namespace)
for $function in $functions
where $function/@lib = $prefix and $function/@name = $local-name
return (
    ``[<pre>`{string-join(local:function-xquery-signatures($function), "
")}`]``,
    ()
)

(:
 : Copyright (C) 2020 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 "3.1";

declare namespace apidoc = "http://marklogic.com/xdmp/apidoc";
declare namespace map = "http://www.w3.org/2005/xpath-functions/map";
declare namespace xhtml = "http://www.w3.org/1999/xhtml";

declare variable $language as xs:string external := "xquery"; (: xquery | javascript | rest :)
declare variable $namespace as xs:string external;
declare variable $local-name as xs:string external;

declare variable $apidoc as element(apidoc:apidoc) :=
    typeswitch (.)
    case xs:string return fn:parse-xml(.)/element()
    case document-node() return ./element()
    default return .;

declare function local:apidoc-language($doc as element()) as xs:string {
    ($doc/@class, "xquery")[1]
};

declare function local:prefix($namespaces as map(*), $namespace as xs:string) as xs:string {
    for $prefix in map:keys($namespaces)
    where map:get($namespaces, $prefix) = $namespace
    return $prefix
};

(: namespaces -------------------------------------------------------------- :)

declare variable $module-namespaces := map:merge(
    for $import in $apidoc//apidoc:module/apidoc:summary//(*:p|*:pre)
    let $match := fn:analyze-string(($import/*:code, $import)[1], "import module (namespace\s*([a-z0-9]+)\s*=\s*)?""([^""]+)""")/fn:match[1]
    let $prefix := $import/ancestor::apidoc:module/@lib
    let $namespace := $match/fn:group[@nr = "3"]/string()
    where exists($namespace)
    return map:entry($prefix, $namespace)
);

declare variable $xquery-namespaces := map {
    "local": "http://www.w3.org/2005/xquery-local-functions",
    "fn": "http://www.w3.org/2005/xpath-functions",
    "xml": "http://www.w3.org/XML/1998/namespace",
    "xs": "http://www.w3.org/2001/XMLSchema",
    "xsi": "http://www.w3.org/2001/XMLSchema-instance"
};

declare variable $marklogic-5-builtin := map {
    "cts": "http://marklogic.com/cts",
    "dbg": "http://marklogic.com/xdmp/dbg",
    "dir": "http://marklogic.com/xdmp/directory",
    "error": "http://marklogic.com/xdmp/error",
    "map": "http://marklogic.com/xdmp/map",
    "math": "http://marklogic.com/xdmp/math",
    "prof": "http://marklogic.com/xdmp/profile",
    "sec": "http://marklogic.com/security",
    "spell": "http://marklogic.com/xdmp/spell",
    "xdmp": "http://marklogic.com/xdmp"
};

declare variable $marklogic-6-builtin := map {
    "err": "http://www.w3.org/2005/xqt-error"
};

declare variable $marklogic-7-builtin := map {
    "rdf": "http://www.w3.org/1999/02/22-rdf-syntax-ns#",
    "sc": "http://marklogic.com/xdmp/schema-components",
    "sql": "http://marklogic.com/xdmp/sql"
};

declare variable $marklogic-10-builtin := map {
    "cntk": "http://marklogic.com/cntk",
    "ort": "http://marklogic.com/onnxruntime"
};

declare variable $marklogic-additional := map {
    "as": "http://marklogic.com/xdmp/assignments",
    "db": "http://marklogic.com/xdmp/database",
    "dg": "xdmp:document-get",
    "cl": "http://marklogic.com/xdmp/clusters",
    "exsl": "http://exslt.org/common",
    "extusr": "http://marklogic.com/xdmp/external/user",
    "gr": "http://marklogic.com/xdmp/group",
    "lang": "http://marklogic.com/xdmp/language",
    "list": "http://marklogic.com/manage/package/list",
    "md": "urn:oasis:names:tc:SAML:2.0:metadata",
    "mt": "http://marklogic.com/xdmp/mimetypes",
    "pkg": "http://marklogic.com/manage/package",
    "s": "http://www.w3.org/2009/xpath-functions/analyze-string",
    "sch": "http://purl.oclc.org/dsdl/schematron",
    "x509": "http://marklogic.com/xdmp/x509",
    "xdt": "http://www.w3.org/2004/10/xpath-datatypes",
    "xi": "http://www.w3.org/2001/XInclude"
};

declare variable $namespaces := map:merge((
    $module-namespaces,
    $xquery-namespaces,
    $marklogic-5-builtin,
    $marklogic-6-builtin,
    $marklogic-7-builtin,
    $marklogic-10-builtin,
    $marklogic-additional,
    ()
));

(: functions --------------------------------------------------------------- :)

(: Several functions in the apidocs have duplicate parameter names in some versions, so fix these. :)
declare variable $param-fixes := map {
    "fn:subtract-dateTimes-yielding-dayTimeDuration": ("srcval1", "srcval2"),
    "fn:subtract-dateTimes-yielding-yearMonthDuration": ("srcval1", "srcval2"),
    "geo:region-contains": ("target", "region", "options"),
    "math:fmod": ("x", "y"),
    "math:rank": ("arg1", "arg2", "options")
};

declare variable $functions as element(apidoc:function)* := $apidoc//apidoc:function[
    local:function-language(.) = $language and not(@name = "")
];

declare function local:function-language($function as element(apidoc:function)) as xs:string {
    let $bucket := $function/@bucket
    return switch ($bucket)
    case "REST Resources API" return "rest"
    default return local:apidoc-language($function)
};

declare function local:function-name($function as element(apidoc:function)) as xs:string {
    ``[`{$function/@lib}`:`{$function/@name}`]``
};

declare function local:function-parameters($function as element(apidoc:function)) as xs:string* {
    let $names as xs:string* :=
        let $names := map:get($param-fixes, local:function-name($function))
        return if (exists($names)) then
            $names
        else
            $function/apidoc:params/apidoc:param[local:apidoc-language(.) = $language]/@name/string()
    return if (count($names) != count(distinct-values($names))) then
        fn:error(xs:QName("err:XQST0039"),``[Duplicate parameter name in `{local:function-name($function)}`]``)
    else
        $names
};

declare function local:function-parameter($function as element(apidoc:function), $name as xs:string) as element(apidoc:param) {
    let $names := map:get($param-fixes, local:function-name($function))
    return if (exists($names)) then
        let $i := fn:index-of($names, $name)
        return $function/apidoc:params/apidoc:param[$i]
    else
        $function/apidoc:params/apidoc:param[@name = $name and local:apidoc-language(.) = $language]
};

declare function local:function-parameter-type($function as element(apidoc:function), $name as xs:string) as xs:string {
    let $type := local:function-parameter($function, $name)/@type/string()
    return switch ($type)
    case "atomic type" return "item()*"
    case "xs:string)" return "xs:string"
    case "xs:dateTime? | xs:date? | xs:string?" return "(xs:dateTime?|xs:date?|xs:string?)"
    case "binary())" return "binary()"
    case "element(sec:query-rolesets)*)" return "element(sec:query-rolesets)*"
    case "function()" return "function(*)"
    case "item()* | map:map" return "(item()*|map:map)"
    case "(binary()|node())*" return "(binary()*|node()*)"
    case "(binary()|node())?" return "(binary()?|node()?)"
    case "(element()|map:map)?" case "element()?|map:map?" return "(element()?|map:map?)"
    case "(node()? | map:map)?" return "(node()?|map:map?)"
    case "(cts:order|xs:string)*" return "(cts:order*|xs:string*)"
    case "[xs:string?]" return "xs:string?"
    default return replace($type, ",\.\.\.", "...")
};

declare function local:function-return-type($function as element(apidoc:function)) as xs:string {
    let $type := normalize-space($function/apidoc:return[local:apidoc-language(.) = $language])
    return switch ($type)
    case "An XML representation of the certificate." return "element()?"
    case "element())" case "Element()" return "element()"
    case "element()|map:map" return "(element()|map:map)"
    case "element(xsd:schema)*" return "element(xs:schema)*"
    case "empty-sequence" case "empty sequence" return "empty-sequence()"
    case "xs:string)" return "xs:string"
    case "xs:unsignedLong)" return "xs:unsignedLong"
    case "pkgins:install($pkgname)" return "element(pkg:install-status)"
    case "pkgins:revert($ticket)" return "element(pkg:revert-status)"
    case "query-results-serialize($results)" return "item()*"
    case "The return data type is the data type of the date argument" return "item()"
    case "" return
        switch (local:function-name($function))
        case "admin:appserver-set-output-indent-tabs" return "element(configuration)"
        default return ""
    default return $type
};

declare function local:function-xquery-signatures($function as element(apidoc:function)) as xs:string* {
    let $name := local:function-name($function)
    let $params :=
        for $name in local:function-parameters($function)
        let $type := local:function-parameter-type($function, $name)
        return ``[$`{$name}` as `{$type}`]``
    let $type := local:function-return-type($function)
    return if ($type = "") then
        ``[declare function `{$name}`(`{string-join($params, ", ")}`) external;]``
    else
        ``[declare function `{$name}`(`{string-join($params, ", ")}`) as `{$type}` external;]``
};

(: query ------------------------------------------------------------------- :)

let $prefix := local:prefix($namespaces, $namespace)
for $function in $functions
where $function/@lib = $prefix and $function/@name = $local-name
return local:function-xquery-signatures($function)


Corpus ID variable

Corpus ID variable

declare namespace scholarNET='https://scholarnet.github.io/';

declare variable $voyantCorpusID :='a05c92769b2183e6e05332abe89c9fde';

declare variable $search-string-file := doc('../pre-voyant-search-strings.tsv');

declare variable $prefixes := ('ب','ل','ك','ف','و');

(: If turned on will only search for variants that include any shaddas in above strings. :)
declare variable $require-existing-shadda := 1;

(: If turned on will not allow any vowels provided in $search-strings to be absent. If off, will match any specified vowels as well as unvocalized versions, but not alternate vowels. :)
declare variable $require-existing-vowels := 0;

(: If turned on will add a search term with the definite article prefixed to the word. :)
declare variable $add-optional-article := 1;

(: If turned on will add attached prepositions and conjunctions as optional search strings. :)
declare variable $add-optional-prefixes := 1;

declare function scholarNET:process-shadda($search-string as xs:string) as xs:string {

    if ($require-existing-vowels) then
        if ($require-existing-shadda) then
            replace(replace($search-string, '([ً-ِْ-ٖ])','(ّ)?$1(ّ)?'),'((ّ)\(ّ\)\?([ً-ِْ-ٖ])\(ّ\)\?)|(\(ّ\)\?([ً-ِْ-ٖ])\(ّ\)\?(ّ))','(ّ)$3$5') (: optional shadda before / after required vowel, but keeps existing shaddas by replacing optional shaddas with required. :)
            (: NB: Looks for required shadda only before required vowel, since Voyant does not seem to support parentheses. :)
        else
            replace(replace($search-string, '([ً-ِْ-ٖ])','(ّ)?$1(ّ)?'),'((ّ)\(ّ\)\?)|(\(ّ\)\?(ّ))','(ّ)?') (: optional shadda before / after required vowel, ignoring existing shaddas by removing duplicate shaddas :)
    else
        if ($require-existing-shadda) then
            replace(replace($search-string, '([ً-ِْ-ٖ])','(ّ)?$1?(ّ)?'),'((ّ)\(ّ\)\?([ً-ِْ-ٖ]\?)\(ّ\)\?)|(\(ّ\)\?([ً-ِْ-ٖ]\?)\(ّ\)\?(ّ))','(ّ)$3$5') (: required shadda + optional existing vowel :)
            (: NB: Looks for required shadda only before optional vowel, since Voyant does not seem to support parentheses. :)
        else
            replace(replace($search-string, '([ً-ٖ])','[(ّ)$1]*'),'(ّ)?(\[\(ّ\)[ً-ٖ]\]\*)(ّ)?','$1') (: optional existing vowel + optional shadda, in any order, replacing existing shaddas :)
};

declare function scholarNET:add-vowels($search-string as xs:string) as xs:string {

if ($require-existing-shadda) then
        replace(
            replace(
                replace(
                    $search-string,
                    '([ء-ي])((\(ّ\))?\??)',
                    '$1$2[ً-ِْ-ٖ]*') (: Adds vowel wildcard after all consonants (behind any required/optional shaddas) :)
                ,'\[ً-ِْ-ٖ\]\*([ً-ِْ-ٖ])'
                ,'$1'), (: Then removes wildcard if it is next to an existing vowel. :)
            '([ء-ي])\[ً-ِْ-ٖ\]\*',
            '$1[ً-ٖ]*') (: If there is no shadda normalizes to shadda-agnostic. :)
    else
        replace(
            replace(
                $search-string,
                '([ء-ي])',
                '$1[ً-ٖ]*') (: Adds vowel wildcard after all consonants :)
            ,'\[ً-ٖ\]\*([\(ّ])'
            ,'$1') (: Then removes wildcard if it is next to an existing vowel-shadda combo. :)
};

(: Removes final vowel because it confuses Voyant Tools. :)
declare function scholarNET:removeFinalVowel($search-string as xs:string) as xs:string {
    replace(
        replace($search-string,
        '\[ً-ٖ\]\*(\*?)($|\|)',
        '$1$2'),
    '\[ً-ِْ-ٖ\]\*(\*?)($|\|)',
    '$1$2')
};

declare function scholarNET:addArticle($search-string as xs:string) as xs:string {
    if ($add-optional-article) then
         (: Duplicates each segment of the search string, adding the article on the front of one. :)
            replace($search-string,'(.+)','$1|الْ?$1')
        else $search-string
};

declare function scholarNET:addPrefixes($search-string as xs:string) as xs:string {
    if ($add-optional-prefixes) then
            let $prefixes-to-add := concat(string-join($prefixes,'?[ً-ِْ-ٖ]?'),'?[ً-ِْ-ٖ]?')
            (: Breaks string into segments by | character and adds prefix query to each string, then rejoins them. :)
            let $prefixes-added := concat($prefixes-to-add,string-join(tokenize($search-string,'\|'),concat('|',$prefixes-to-add)))
            (: Accounts for elided ا when preposition ل is added producing لل instead of لال.
            Duplicates the form with the article (if present) and creates an additional form with لل in place
            of the article. :)
            return if (string-length(normalize-space($search-string))) then
            replace(
                replace(
                    $prefixes-added,
                    concat('((',$prefixes-to-add,')(الْ\?)(.+?(\||$)))'),
                    '$1|لِ?لْ?$4'),
                '\|\|',
                '|')
            else $search-string
        else $search-string
};

declare function scholarNET:normalizeAYW($search-string as xs:string) as xs:string {
let $normalize-alif := replace($search-string,'ا','[آاإأ]')
let $normalize-ya := replace($normalize-alif,'ى','[يىئ]')
return replace($normalize-ya,'و','[وؤ]')
};

declare function scholarNET:voyantSearchString($search-string as xs:string) as xs:string {
    replace(
        scholarNET:normalizeAYW(
            scholarNET:addPrefixes(
                scholarNET:addArticle(
                    scholarNET:removeFinalVowel(
                        scholarNET:add-vowels(
                            scholarNET:process-shadda($search-string)
                            )
                        )
                    )
                )
            ),
       '\(ّ\)','ّ')
};

let $rows := tokenize($search-string-file/root,'\n')

let $processed-rows :=
    for $row in $rows[position()>1]
        let $cells := tokenize($row,'\t')
        let $label := $cells[1]
        let $search-strings :=
            for $cell in $cells[position()>1]
            return (scholarNET:voyantSearchString($cell))
        let $cluster := string-join($cells[position()>1 and string-length(.)],'|')
        let $search-strings-combined := replace(string-join($search-strings,'|'),'\|+\s*$','')
        let $search-url :=
            concat(
                    'http://voyant-tools.org/?corpus=',
                    $voyantCorpusID,
                    '&view=Contexts&query=',
                    escape-html-uri($search-strings-combined),
                    '&context=50&expand=500')
        return (string-join(($label,$search-strings-combined,$cluster,$search-url),'	'),'
')

return (
    concat(string-join(('Macro-affiliation','Search String','Search Cluster','Link (replace ampersands)'),'	'),'
'),
    $processed-rows
    )

declare namespace scholarNET='https://scholarnet.github.io/';

declare variable $search-string-file := doc('../pre-voyant-search-strings.tsv');

declare variable $prefixes := ('ب','ل','ك','ف','و');

(: If turned on will only search for variants that include any shaddas in above strings. :)
declare variable $require-existing-shadda := 1;

(: If turned on will not allow any vowels provided in $search-strings to be absent. If off, will match any specified vowels as well as unvocalized versions, but not alternate vowels. :)
declare variable $require-existing-vowels := 0;

(: If turned on will add a search term with the definite article prefixed to the word. :)
declare variable $add-optional-article := 1;

(: If turned on will add attached prepositions and conjunctions as optional search strings. :)
declare variable $add-optional-prefixes := 1;

declare function scholarNET:process-shadda($search-string as xs:string) as xs:string {

    if ($require-existing-vowels) then
        if ($require-existing-shadda) then
            replace(replace($search-string, '([ً-ِْ-ٖ])','(ّ)?$1(ّ)?'),'((ّ)\(ّ\)\?([ً-ِْ-ٖ])\(ّ\)\?)|(\(ّ\)\?([ً-ِْ-ٖ])\(ّ\)\?(ّ))','(ّ)$3$5') (: optional shadda before / after required vowel, but keeps existing shaddas by replacing optional shaddas with required. :)
            (: NB: Looks for required shadda only before required vowel, since Voyant does not seem to support parentheses. :)
        else
            replace(replace($search-string, '([ً-ِْ-ٖ])','(ّ)?$1(ّ)?'),'((ّ)\(ّ\)\?)|(\(ّ\)\?(ّ))','(ّ)?') (: optional shadda before / after required vowel, ignoring existing shaddas by removing duplicate shaddas :)
    else
        if ($require-existing-shadda) then
            replace(replace($search-string, '([ً-ِْ-ٖ])','(ّ)?$1?(ّ)?'),'((ّ)\(ّ\)\?([ً-ِْ-ٖ]\?)\(ّ\)\?)|(\(ّ\)\?([ً-ِْ-ٖ]\?)\(ّ\)\?(ّ))','(ّ)$3$5') (: required shadda + optional existing vowel :)
            (: NB: Looks for required shadda only before optional vowel, since Voyant does not seem to support parentheses. :)
        else
            replace(replace($search-string, '([ً-ٖ])','[(ّ)$1]*'),'(ّ)?(\[\(ّ\)[ً-ٖ]\]\*)(ّ)?','$1') (: optional existing vowel + optional shadda, in any order, replacing existing shaddas :)
};

declare function scholarNET:add-vowels($search-string as xs:string) as xs:string {

if ($require-existing-shadda) then
        replace(
            replace(
                replace(
                    $search-string,
                    '([ء-ي])((\(ّ\))?\??)',
                    '$1$2[ً-ِْ-ٖ]*') (: Adds vowel wildcard after all consonants (behind any required/optional shaddas) :)
                ,'\[ً-ِْ-ٖ\]\*([ً-ِْ-ٖ])'
                ,'$1'), (: Then removes wildcard if it is next to an existing vowel. :)
            '([ء-ي])\[ً-ِْ-ٖ\]\*',
            '$1[ً-ٖ]*') (: If there is no shadda normalizes to shadda-agnostic. :)
    else
        replace(
            replace(
                $search-string,
                '([ء-ي])',
                '$1[ً-ٖ]*') (: Adds vowel wildcard after all consonants :)
            ,'\[ً-ٖ\]\*([\(ّ])'
            ,'$1') (: Then removes wildcard if it is next to an existing vowel-shadda combo. :)
};

(: Removes final vowel because it confuses Voyant Tools. :)
declare function scholarNET:removeFinalVowel($search-string as xs:string) as xs:string {
    replace(
        replace($search-string,
        '\[ً-ٖ\]\*(\*?)($|\|)',
        '$1$2'),
    '\[ً-ِْ-ٖ\]\*(\*?)($|\|)',
    '$1$2')
};

declare function scholarNET:addArticle($search-string as xs:string) as xs:string {
    if ($add-optional-article) then
         (: Duplicates each segment of the search string, adding the article on the front of one. :)
            replace($search-string,'(.+)','$1|الْ?$1')
        else $search-string
};

declare function scholarNET:addPrefixes($search-string as xs:string) as xs:string {
    if ($add-optional-prefixes) then
            let $prefixes-to-add := concat(string-join($prefixes,'?[ً-ِْ-ٖ]?'),'?[ً-ِْ-ٖ]?')
            (: Breaks string into segments by | character and adds prefix query to each string, then rejoins them. :)
            let $prefixes-added := concat($prefixes-to-add,string-join(tokenize($search-string,'\|'),concat('|',$prefixes-to-add)))
            (: Accounts for elided ا when preposition ل is added producing لل instead of لال.
            Duplicates the form with the article (if present) and creates an additional form with لل in place
            of the article. :)
            return if (string-length(normalize-space($search-string))) then
            replace(
                replace(
                    $prefixes-added,
                    concat('((',$prefixes-to-add,')(الْ\?)(.+?(\||$)))'),
                    '$1|لِ?لْ?$4'),
                '\|\|',
                '|')
            else $search-string
        else $search-string
};

declare function scholarNET:normalizeAYW($search-string as xs:string) as xs:string {
let $normalize-alif := replace($search-string,'ا','[آاإأ]')
let $normalize-ya := replace($normalize-alif,'ى','[يىئ]')
return replace($normalize-ya,'و','[وؤ]')
};

declare function scholarNET:voyantSearchString($search-string as xs:string) as xs:string {
    replace(
        scholarNET:normalizeAYW(
            scholarNET:addPrefixes(
                scholarNET:addArticle(
                    scholarNET:removeFinalVowel(
                        scholarNET:add-vowels(
                            scholarNET:process-shadda($search-string)
                            )
                        )
                    )
                )
            ),
       '\(ّ\)','ّ')
};

let $rows := tokenize($search-string-file/root,'\n')

let $processed-rows :=
    for $row in $rows[position()>1]
        let $cells := tokenize($row,'\t')
        let $label := $cells[1]
        let $search-strings :=
            for $cell in $cells[position()>1]
            return (scholarNET:voyantSearchString($cell))
        let $cluster := string-join($cells[position()>1 and string-length(.)],'|')
        let $search-strings-combined := replace(string-join($search-strings,'|'),'\|+\s*$','')
        let $search-url :=
            concat(
                    'http://voyant-tools.org/?corpus=90e03a27efc07a543ee15f894a2db0a0&view=Contexts&query=',
                    escape-html-uri($search-strings-combined),
                    '&context=50&expand=500')
        return (string-join(($label,$search-strings-combined,$cluster,$search-url),'	'),'
')

return (
    concat(string-join(('Macro-affiliation','Search String','Search Cluster','Link (replace ampersands)'),'	'),'
'),
    $processed-rows
    )


[bugfix] Fix XML Test runner loading of classpath resources on Windows

xquery version "3.1";

module namespace t = "http://exist-db.org/xquery/testing";

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

declare namespace err = "http://www.w3.org/2005/xqt-errors";
declare namespace exerr = "http://www.exist-db.org/xqt-errors/";

declare function t:setup-action($action) {
    typeswitch ($action)
        case element(create-collection) return
            xmldb:create-collection($action/@parent, $action/@name)
        case element(store) return
			t:store($action)
		case element(store-files) return
            t:store-files($action)
        case element(remove-collection) return
            if ($action/@ignore-missing eq "true" and not(xmldb:collection-available($action/@collection)))
            then ()
            else
                xmldb:remove($action/@collection)
        case element(remove-document) return
            xmldb:remove($action/@collection, $action/@name)
        default return
            ()
};

declare function t:store($action as element(store)) {
    let $type := if ($action/@type) then $action/@type/string() else "application/xml"
    let $data :=
		if ($action/*) then
			$action/*[1]
		else
			$action/string()
	return
        xmldb:store($action/@collection, $action/@name, $data, $type)
};

declare function t:store-files($action as element(store-files)) {
    let $type := if ($action/@type) then $action/@type/string() else "application/xml"
    return
        if ($action/@classpath)
        then
            let $classpath-entries := util:system-property("java.class.path")
            let $path-separator := util:system-property("path.separator")
            let $cp :=
                if (util:system-property("file.separator") eq '/')
                then
                    $action/@classpath
                else
                    replace($action/@classpath, '/', '\\')
            let $matches := fn:tokenize($classpath-entries, $path-separator)[fn:ends-with(., $cp)]
            return
                if (not(empty($matches)))
                then
                    xmldb:store-files-from-pattern($action/@collection, $matches[1], $action/@pattern, $type)
                else
                    util:log("ERROR", ("Could not match classpath with '" || $action/@classpath || "' in test.xq"))
        else
            xmldb:store-files-from-pattern($action/@collection, $action/@dir, $action/@pattern, $type)
};

declare function t:setup($setup as element(setup)?) {
    for $action in $setup/*
    return
        t:setup-action($action)
};

declare function t:tearDown($tearDown as element(tearDown)?) {
    for $action in $tearDown/*
    return
        t:setup-action($action)
};

declare function t:declare-variable($var as element(variable)) as item()? {
    let $children := $var/*
    return
        if (empty($children)) then
            string-join($var/node(), '')
        else
            fn:serialize($children)
};

declare function t:init-prolog($test as element(test)) {
	let $imports := $test/../imports
	let $vars :=
	    string-join(
        	for $var in $test/../variable
        	return
        	    concat("declare variable $", $var/@name, " := ", t:declare-variable($var), ";"),
            ""
        )
	return
		string-join(($imports, $vars, $test/../functions), '')
};

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

declare function t:run-test($test as element(test), $count as xs:integer) {
    t:run-test($test, $count, (), (), (), (), (), ())
};

declare function t:run-test($test as element(test), $count as xs:integer,
        $test-ignored-function as (function(xs:string) as empty-sequence())?,
        $test-started-function as (function(xs:string) as empty-sequence())?,
        $test-failure-function as (function(xs:string, map(xs:string, item()?), map(xs:string, item()?)) as empty-sequence())?,
        $test-assumption-failed-function as (function(xs:string, map(xs:string, item()?)?) as empty-sequence())?,
        $test-error-function as (function(xs:string, map(xs:string, item()?)?) as empty-sequence())?,
        $test-finished-function as (function(xs:string) as empty-sequence())?) {
	let $context := t:init-prolog($test)
	let $null :=
	   if ($test/@trace eq 'yes') then
	       (system:clear-trace(), system:enable-tracing(true(), false()))
       else ()
    let $highlight-option := concat("highlight-matches=",
          if ($test/expected//@*[matches(., '^(\|{3}).*\1$')] and $test/expected//exist:match) then "both"
          else if ($test/expected//@*[matches(., '^(\|{3}).*\1$')]) then "attributes"
          else if ($test/expected//exist:match) then "elements"
          else "none"
          )
    let $serialize-options :=
      let $decls := ($test/../*[name() ne 'test']|$test/code)[matches(., 'declare[\- ]option(\(("|')|\s+)exist:serialize(\2,)?\s+("|').*?\4[;)]')]
      let $ops1 := $decls/replace(., "declare[\- ]option(\(("|')|\s+)exist:serialize(\2,)?\s+("|')(.*?)\4[;)]", "_|$5_")
      let $ops2 :=
        for $a in $ops1
        for $b in tokenize($a, '_')[starts-with(., '|')]
        return tokenize(substring-after($b, '|'), '\s+')
      return if (count($ops2[matches(., 'highlight-matches')]))
        then string-join($ops2, ' ')
        else string-join(($ops2, $highlight-option), ' ')
    let $_notify-start := if(not(empty($test-started-function))) then $test-started-function($test/task) else ()
    let $queryOutput :=
        try {
            map {
                "result": util:eval(concat($context, $test/code/string()), false())
            }
        } catch * {
            map {
                "error": map {
                    "code": $err:code,
                    "description": $err:description,
                    "value": $err:value,
                    "module": $err:module,
                    "line-number": $err:line-number,
                    "column-number": $err:column-number,
                    "additional": $err:additional,
                    "xquery-stack-trace": $exerr:xquery-stack-trace,
                    "java-stack-trace": $exerr:java-stack-trace
                }
            }
        }
	let $output := if ($test/@trace eq 'yes') then map { "result": system:trace() } else $queryOutput
    let $expanded :=
        if (not(empty($output("error")))) then
            $output
        else if ($test/@serialize) then
            try {

                let $ser-params := map:merge(
                    let $options := fn:tokenize($test/@serialize/string(), " ")
                    for $option in $options
                    let $kv := fn:tokenize($option, "=")
                    return
                        map:entry($kv[1], $kv[2])
                )
                return
                    map {
                        "result": normalize-space(string-join($output("result") ! fn:serialize(., $ser-params)))
                    }
            } catch * {
                map {
                    "error": map {
                        "code": $err:code,
                        "description": $err:description,
                        "value": $err:value,
                        "module": $err:module,
                        "line-number": $err:line-number,
                        "column-number": $err:column-number,
                        "additional": $err:additional,
                        "xquery-stack-trace": $exerr:xquery-stack-trace,
                        "java-stack-trace": $exerr:java-stack-trace
                    }
                }
            }

		else if ($output("result") instance of node()) then
        	map {
        	    "result": util:expand($output("result"), $serialize-options)
        	}
		else
			$output
    let $expected :=
        if ($test/@output eq 'text') then
            data($test/expected)
        else $test/expected/node()
    let $OK :=
        if ($test/error) then
            not(empty($expanded("error"))) and (contains($expanded("error")("description"), $test/error) or local-name-from-QName($expanded("error")("code")) eq string($test/error))
        else if ($test/xpath) then
            t:test(t:xpath($output("result"), $test/xpath))
        else if ($test/@output eq 'text') then
            let $asString :=
                if ($test/@serialize) then
                    $expanded("result")
                else
                    normalize-space(string-join(for $x in $output("result") return string($x),' '))
            return
                $asString eq normalize-space($expected)
        else
            let $xn := t:normalize($expanded("result"))
            let $en := t:normalize($expected)
            return
        	   deep-equal($xn, $en)
    return
        (
            <test n="{$count}" pass="{$OK}">
            { $test/@id }
            {
                if (not($OK)) then
                    let $_notify :=
                        if(not(empty($expanded("error")))) then
                            if(not(empty($test-error-function))) then $test-error-function($test/task, $expanded("error")) else ()
                        else
                            if(not(empty($test-failure-function))) then $test-failure-function($test/task, map { "value": $test/expected/node(), "xpath": $test/xpath/node(), "error": $test/error/node() }, $expanded) else ()
                    return
                        ($test/task, $test/expected, $test/xpath, <result>{$expanded("result"), if(not(empty($expanded("error")))) then $expanded("error")("description") else ()}</result>)
                else
                    ()
            }
            </test>
            ,
            let $_notify-finished := if(not(empty($test-finished-function))) then $test-finished-function($test/task) else ()
            return ()
        )
};

declare function t:normalize($nodes as node()*) {
	for $node in $nodes return t:normalize-node($node)
};

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

declare function t:xpath($output as item()*, $xpath as element()) {
    for $prefix in in-scope-prefixes($xpath)
    let $nsuri := namespace-uri-for-prefix($prefix, $xpath)
    return
        if ($prefix != 'xml') then
            util:declare-namespace($prefix, $nsuri)
        else (),
    let $expr := $xpath/string()
    return
        if (matches($expr, "^\s*/")) then
            util:eval(concat("$output", $expr))
        else
            util:eval($expr)
};

declare function t:run-testSet($set as element(TestSet), $id as xs:string?) {
    t:run-testSet($set, $id, (), (), (), (), (), ())
};

declare function t:run-testSet($set as element(TestSet), $id as xs:string?,
        $test-ignored-function as (function(xs:string) as empty-sequence())?,
        $test-started-function as (function(xs:string) as empty-sequence())?,
        $test-failure-function as (function(xs:string, map(xs:string, item()?), map(xs:string, item()?)) as empty-sequence())?,
        $test-assumption-failed-function as (function(xs:string, map(xs:string, item()?)?) as empty-sequence())?,
        $test-error-function as (function(xs:string, map(xs:string, item()?)?) as empty-sequence())?,
        $test-finished-function as (function(xs:string) as empty-sequence())?) {
    let $copy := util:expand($set)
    let $null := t:setup($copy/setup)
    let $tests :=
        if ($id) then
            $copy/test[@id = $id]
        else
            for $test in $copy/test
            return
                if($test[empty(@ignore) or @ignore = "no"])then
                    $test
                else
                    let $_notify-ignored := if(not(empty($test-ignored-function))) then $test-ignored-function($test/task) else ()
                    return ()
    let $result := util:expand(
           <TestSet>
           {$copy/testName}
           {$copy/description}
           {
               for $test at $p in $tests
               return
                   t:run-test($test, $p,
                        $test-ignored-function, $test-started-function, $test-failure-function,
                        $test-assumption-failed-function, $test-error-function, $test-finished-function)
           }
           </TestSet>
        )
    let $null := t:tearDown($copy/tearDown)
    return $result
};

declare function t:format-testResult($result) {
    let $formatted :=

{$result/testName}

{$result/description/p}

          {for $test in $result//test
           return

                    {$test/@n/.}
                    {$test/@pass/.}

          }

     return
        $formatted
};

xquery version "3.1";

module namespace t = "http://exist-db.org/xquery/testing";

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

declare namespace err = "http://www.w3.org/2005/xqt-errors";
declare namespace exerr = "http://www.exist-db.org/xqt-errors/";

declare function t:setup-action($action) {
    typeswitch ($action)
        case element(create-collection) return
            xmldb:create-collection($action/@parent, $action/@name)
        case element(store) return
			t:store($action)
		case element(store-files) return
            t:store-files($action)
        case element(remove-collection) return
            if ($action/@ignore-missing eq "true" and not(xmldb:collection-available($action/@collection)))
            then ()
            else
                xmldb:remove($action/@collection)
        case element(remove-document) return
            xmldb:remove($action/@collection, $action/@name)
        default return
            ()
};

declare function t:store($action as element(store)) {
    let $type := if ($action/@type) then $action/@type/string() else "application/xml"
    let $data :=
		if ($action/*) then
			$action/*[1]
		else
			$action/string()
	return
        xmldb:store($action/@collection, $action/@name, $data, $type)
};

declare function t:store-files($action as element(store-files)) {
    let $type := if ($action/@type) then $action/@type/string() else "application/xml"
    return
        if ($action/@classpath)
        then
            let $classpath-entries := util:system-property("java.class.path")
            let $matches := fn:tokenize($classpath-entries, ":")[fn:ends-with(., $action/@classpath)]
            return
                if (not(empty($matches)))
                then
                    xmldb:store-files-from-pattern($action/@collection, $matches[1], $action/@pattern, $type)
                else
                    util:log("ERROR", ("Could not match classpath with '" || $action/@classpath || "' in test.xq"))
        else
            xmldb:store-files-from-pattern($action/@collection, $action/@dir, $action/@pattern, $type)
};

declare function t:setup($setup as element(setup)?) {
    for $action in $setup/*
    return
        t:setup-action($action)
};

declare function t:tearDown($tearDown as element(tearDown)?) {
    for $action in $tearDown/*
    return
        t:setup-action($action)
};

declare function t:declare-variable($var as element(variable)) as item()? {
    let $children := $var/*
    return
        if (empty($children)) then
            string-join($var/node(), '')
        else
            fn:serialize($children)
};

declare function t:init-prolog($test as element(test)) {
	let $imports := $test/../imports
	let $vars :=
	    string-join(
        	for $var in $test/../variable
        	return
        	    concat("declare variable $", $var/@name, " := ", t:declare-variable($var), ";"),
            ""
        )
	return
		string-join(($imports, $vars, $test/../functions), '')
};

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

declare function t:run-test($test as element(test), $count as xs:integer) {
    t:run-test($test, $count, (), (), (), (), (), ())
};

declare function t:run-test($test as element(test), $count as xs:integer,
        $test-ignored-function as (function(xs:string) as empty-sequence())?,
        $test-started-function as (function(xs:string) as empty-sequence())?,
        $test-failure-function as (function(xs:string, map(xs:string, item()?), map(xs:string, item()?)) as empty-sequence())?,
        $test-assumption-failed-function as (function(xs:string, map(xs:string, item()?)?) as empty-sequence())?,
        $test-error-function as (function(xs:string, map(xs:string, item()?)?) as empty-sequence())?,
        $test-finished-function as (function(xs:string) as empty-sequence())?) {
	let $context := t:init-prolog($test)
	let $null :=
	   if ($test/@trace eq 'yes') then
	       (system:clear-trace(), system:enable-tracing(true(), false()))
       else ()
    let $highlight-option := concat("highlight-matches=",
          if ($test/expected//@*[matches(., '^(\|{3}).*\1$')] and $test/expected//exist:match) then "both"
          else if ($test/expected//@*[matches(., '^(\|{3}).*\1$')]) then "attributes"
          else if ($test/expected//exist:match) then "elements"
          else "none"
          )
    let $serialize-options :=
      let $decls := ($test/../*[name() ne 'test']|$test/code)[matches(., 'declare[\- ]option(\(("|')|\s+)exist:serialize(\2,)?\s+("|').*?\4[;)]')]
      let $ops1 := $decls/replace(., "declare[\- ]option(\(("|')|\s+)exist:serialize(\2,)?\s+("|')(.*?)\4[;)]", "_|$5_")
      let $ops2 :=
        for $a in $ops1
        for $b in tokenize($a, '_')[starts-with(., '|')]
        return tokenize(substring-after($b, '|'), '\s+')
      return if (count($ops2[matches(., 'highlight-matches')]))
        then string-join($ops2, ' ')
        else string-join(($ops2, $highlight-option), ' ')
    let $_notify-start := if(not(empty($test-started-function))) then $test-started-function($test/task) else ()
    let $queryOutput :=
        try {
            map {
                "result": util:eval(concat($context, $test/code/string()), false())
            }
        } catch * {
            map {
                "error": map {
                    "code": $err:code,
                    "description": $err:description,
                    "value": $err:value,
                    "module": $err:module,
                    "line-number": $err:line-number,
                    "column-number": $err:column-number,
                    "additional": $err:additional,
                    "xquery-stack-trace": $exerr:xquery-stack-trace,
                    "java-stack-trace": $exerr:java-stack-trace
                }
            }
        }
	let $output := if ($test/@trace eq 'yes') then map { "result": system:trace() } else $queryOutput
    let $expanded :=
        if (not(empty($output("error")))) then
            $output
        else if ($test/@serialize) then
            try {

                let $ser-params := map:merge(
                    let $options := fn:tokenize($test/@serialize/string(), " ")
                    for $option in $options
                    let $kv := fn:tokenize($option, "=")
                    return
                        map:entry($kv[1], $kv[2])
                )
                return
                    map {
                        "result": normalize-space(string-join($output("result") ! fn:serialize(., $ser-params)))
                    }
            } catch * {
                map {
                    "error": map {
                        "code": $err:code,
                        "description": $err:description,
                        "value": $err:value,
                        "module": $err:module,
                        "line-number": $err:line-number,
                        "column-number": $err:column-number,
                        "additional": $err:additional,
                        "xquery-stack-trace": $exerr:xquery-stack-trace,
                        "java-stack-trace": $exerr:java-stack-trace
                    }
                }
            }

		else if ($output("result") instance of node()) then
        	map {
        	    "result": util:expand($output("result"), $serialize-options)
        	}
		else
			$output
    let $expected :=
        if ($test/@output eq 'text') then
            data($test/expected)
        else $test/expected/node()
    let $OK :=
        if ($test/error) then
            not(empty($expanded("error"))) and (contains($expanded("error")("description"), $test/error) or local-name-from-QName($expanded("error")("code")) eq string($test/error))
        else if ($test/xpath) then
            t:test(t:xpath($output("result"), $test/xpath))
        else if ($test/@output eq 'text') then
            let $asString :=
                if ($test/@serialize) then
                    $expanded("result")
                else
                    normalize-space(string-join(for $x in $output("result") return string($x),' '))
            return
                $asString eq normalize-space($expected)
        else
            let $xn := t:normalize($expanded("result"))
            let $en := t:normalize($expected)
            return
        	   deep-equal($xn, $en)
    return
        (
            <test n="{$count}" pass="{$OK}">
            { $test/@id }
            {
                if (not($OK)) then
                    let $_notify :=
                        if(not(empty($expanded("error")))) then
                            if(not(empty($test-error-function))) then $test-error-function($test/task, $expanded("error")) else ()
                        else
                            if(not(empty($test-failure-function))) then $test-failure-function($test/task, map { "value": $test/expected/node(), "xpath": $test/xpath/node(), "error": $test/error/node() }, $expanded) else ()
                    return
                        ($test/task, $test/expected, $test/xpath, <result>{$expanded("result"), if(not(empty($expanded("error")))) then $expanded("error")("description") else ()}</result>)
                else
                    ()
            }
            </test>
            ,
            let $_notify-finished := if(not(empty($test-finished-function))) then $test-finished-function($test/task) else ()
            return ()
        )
};

declare function t:normalize($nodes as node()*) {
	for $node in $nodes return t:normalize-node($node)
};

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

declare function t:xpath($output as item()*, $xpath as element()) {
    for $prefix in in-scope-prefixes($xpath)
    let $nsuri := namespace-uri-for-prefix($prefix, $xpath)
    return
        if ($prefix != 'xml') then
            util:declare-namespace($prefix, $nsuri)
        else (),
    let $expr := $xpath/string()
    return
        if (matches($expr, "^\s*/")) then
            util:eval(concat("$output", $expr))
        else
            util:eval($expr)
};

declare function t:run-testSet($set as element(TestSet), $id as xs:string?) {
    t:run-testSet($set, $id, (), (), (), (), (), ())
};

declare function t:run-testSet($set as element(TestSet), $id as xs:string?,
        $test-ignored-function as (function(xs:string) as empty-sequence())?,
        $test-started-function as (function(xs:string) as empty-sequence())?,
        $test-failure-function as (function(xs:string, map(xs:string, item()?), map(xs:string, item()?)) as empty-sequence())?,
        $test-assumption-failed-function as (function(xs:string, map(xs:string, item()?)?) as empty-sequence())?,
        $test-error-function as (function(xs:string, map(xs:string, item()?)?) as empty-sequence())?,
        $test-finished-function as (function(xs:string) as empty-sequence())?) {
    let $copy := util:expand($set)
    let $null := t:setup($copy/setup)
    let $tests :=
        if ($id) then
            $copy/test[@id = $id]
        else
            for $test in $copy/test
            return
                if($test[empty(@ignore) or @ignore = "no"])then
                    $test
                else
                    let $_notify-ignored := if(not(empty($test-ignored-function))) then $test-ignored-function($test/task) else ()
                    return ()
    let $result := util:expand(
           <TestSet>
           {$copy/testName}
           {$copy/description}
           {
               for $test at $p in $tests
               return
                   t:run-test($test, $p,
                        $test-ignored-function, $test-started-function, $test-failure-function,
                        $test-assumption-failed-function, $test-error-function, $test-finished-function)
           }
           </TestSet>
        )
    let $null := t:tearDown($copy/tearDown)
    return $result
};

declare function t:format-testResult($result) {
    let $formatted :=

{$result/testName}

{$result/description/p}

          {for $test in $result//test
           return

                    {$test/@n/.}
                    {$test/@pass/.}

          }

     return
        $formatted
};