Add flow type collections to traces for xqy xml docs

(:
  Copyright 2012-2018 MarkLogic Corporation

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

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

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

module namespace trace = "http://marklogic.com/data-hub/trace";

import module namespace config = "http://marklogic.com/data-hub/config"
  at "/com.marklogic.hub/config.xqy";

import module namespace consts = "http://marklogic.com/data-hub/consts"
  at "/MarkLogic/data-hub-framework/impl/consts.xqy";

import module namespace err = "http://marklogic.com/data-hub/err"
  at "/MarkLogic/data-hub-framework/impl/error-lib.xqy";

import module namespace hul = "http://marklogic.com/data-hub/hub-utils-lib"
  at "/MarkLogic/data-hub-framework/impl/hub-utils-lib.xqy";

import module namespace json="http://marklogic.com/xdmp/json"
  at "/MarkLogic/json/json.xqy";

import module namespace rfc = "http://marklogic.com/data-hub/run-flow-context"
  at "/MarkLogic/data-hub-framework/impl/run-flow-context.xqy";

import module namespace search = "http://marklogic.com/appservices/search"
  at "/MarkLogic/appservices/search/search.xqy";

declare option xdmp:mapping "false";

(: new trace-settings are initialized for each transaction :)
declare variable $current-trace-settings := map:map();

declare function trace:new-trace() as map:map
{
  map:new((
    map:entry("traceId", xdmp:random()),
    map:entry("created", fn:current-dateTime())
  ))
};

declare function trace:enable-tracing($enabled as xs:boolean)
{
  xdmp:eval('
    declare namespace trace = "http://marklogic.com/data-hub/trace";
    declare variable $enabled external;
    xdmp:document-insert(
      "/com.marklogic.hub/settings/__tracing_enabled__.xml",
      element trace:is-tracing-enabled { if ($enabled) then 1 else 0 },
      xdmp:default-permissions(),
      "hub-core-module")
    ',
    map:new((map:entry("enabled", $enabled))),
    map:new((map:entry("database", xdmp:modules-database()), map:entry("ignoreAmps", fn:true())))
  ),
  hul:invalidate-field-cache("tracing-enabled")
};

declare function trace:enabled() as xs:boolean
{
  let $key := "tracing-enabled"
  let $flag :=  hul:from-field-cache-or-empty($key, ())
  return
    if (exists($flag)) then
      $flag
    else
      hul:set-field-cache(
        $key,
        xdmp:eval('
          declare namespace trace = "http://marklogic.com/data-hub/trace";
          fn:exists(
            cts:search(
              fn:doc("/com.marklogic.hub/settings/__tracing_enabled__.xml"),
              cts:element-value-query(xs:QName("trace:is-tracing-enabled"), "1", ("exact")),
              ("unfiltered", "score-zero", "unchecked", "unfaceted")
            )
          )
        ',(), map:new(map:entry("database", xdmp:modules-database()))),
        xs:dayTimeDuration("PT1M")
      )
};

declare function trace:has-errors() as xs:boolean
{
  (map:get($current-trace-settings, "_has_errors"), fn:false())[1] eq fn:true()
};

declare %private function trace:increment-error-count()
{
  map:put($current-trace-settings, "error-count", trace:get-error-count() + 1)
};

declare function trace:get-error-count()
{
  (map:get($current-trace-settings, "error-count"), 0)[1]
};

declare %private function trace:add-failed-item($item as xs:string)
{
  json:array-push(trace:get-failed-items(), $item)
};

declare %private function trace:add-completed-item($item as xs:string)
{
  json:array-push(trace:get-completed-items(), $item)
};

declare function trace:set-plugin-label(
  $label as xs:string)
{
  trace:set-plugin-label(
    rfc:get-trace($rfc:item-context),
    $label
  )
};

(:
 : Sets the label of the currently running plugin
 :
 : @param $label - the label of the running plugin
 :)
declare function trace:set-plugin-label(
  $current-trace as map:map,
  $label as xs:string)
{
  map:put($current-trace, "plugin-label", $label)
};

declare function trace:get-plugin-label(
  $current-trace as map:map)
as xs:string
{
  map:get($current-trace, "plugin-label")
};

declare function trace:reset-plugin-input()
{
  trace:reset-plugin-input(rfc:get-trace($rfc:item-context))
};

declare function trace:reset-plugin-input(
  $current-trace as map:map)
{
  map:put($current-trace, "plugin-input", json:object())
};

declare %private function trace:get-plugin-input(
  $current-trace as map:map)
{
  let $o := map:get($current-trace, "plugin-input")
  where fn:exists($o)
  return
    if (rfc:is-json()) then
      let $oo := json:object()
      let $_ :=
        for $key in map:keys($o)
        let $value := map:get($o, $key)
        let $value := trace:sanitize-data($value)
        return
         map:put($oo, $key, $value)
      return $oo
    else
      for $key in map:keys($o)
      return
        element { $key } {
          let $value := map:get($o, $key)
          return
            trace:sanitize-data($value)
        }
};

(:
 : Registers an input with the trace library
 :
 : @param $label - the label of the input being registered
 : @param $input - the value of the input being registered
 :)
declare function trace:set-plugin-input(
  $label as xs:string,
  $input)
{
  trace:set-plugin-input(rfc:get-trace($rfc:item-context), $label, $input)
};

declare function trace:set-plugin-input(
  $current-trace as map:map,
  $label as xs:string,
  $input)
{
  let $existing := (map:get($current-trace, "plugin-input"), json:object())[1]
  let $_ := map:put($existing, $label, $input)
  return
    map:put($current-trace, "plugin-input", $existing)
};

declare function trace:get-completed-items()
{
  if (map:contains($current-trace-settings, "completed-items")) then
    map:get($current-trace-settings, "completed-items")
  else
    let $value := json:array()
    let $_ := map:put($current-trace-settings, "completed-items", $value)
    return
      $value
};

declare function trace:get-failed-items()
{
  if (map:contains($current-trace-settings, "failed-items")) then
    map:get($current-trace-settings, "failed-items")
  else
    let $value := json:array()
    let $_ := map:put($current-trace-settings, "failed-items", $value)
    return
      $value
};

declare function trace:write-trace(
  $item-context as map:map)
{
  let $identifier := rfc:get-id($item-context)
  where $identifier instance of xs:string
  return
    trace:add-completed-item($identifier),
  trace:write-error-trace($item-context)
};

declare %private function trace:write-error-trace(
  $item-context as map:map)
{
  let $current-trace := rfc:get-trace($item-context)
  return
    if (trace:enabled() or trace:has-errors()) then (
      let $trace :=
        if (rfc:is-json()) then
          xdmp:to-json((
            map:entry("trace",
              map:new((
                map:entry("jobId", rfc:get-job-id()),
                map:entry("format", rfc:get-data-format()),
                map:entry("traceId", map:get($current-trace, "traceId")),
                map:entry("created", map:get($current-trace, "created")),
                map:entry("identifier", rfc:get-id($item-context)),
                map:entry("flowType", rfc:get-flow-type()),
                map:entry("hasError", trace:has-errors()),
                let $steps := json:array()
                let $_ :=
                  for $step in map:get($current-trace, "traceSteps")
                  return
                    json:array-push($steps, $step)
                return
                  map:entry("steps", $steps)
              ))
            )
          ))
        else
          document {
            element trace {
              element jobId { rfc:get-job-id() },
              element format { rfc:get-data-format() },
              element traceId { map:get($current-trace, "traceId") },
              element created { map:get($current-trace, "created") },
              element identifier { rfc:get-id($item-context) },
              element flowType { rfc:get-flow-type() },
              element hasError { trace:has-errors() },
              element steps {
                for $step in map:get($current-trace, "traceSteps")
                return
                  element step {
                    element label { map:get($step, "label") },
                    element input { map:get($step, "input") },
                    element output { map:get($step, "output") },
                    element error { map:get($step, "error") },
                    element duration { map:get($step, "duration") },
                    element options { map:get($step, "options") }
                  }
              }
            }
          }
      return
        xdmp:eval('
          xquery version "1.0-ml";

          declare option xdmp:mapping "false";

          declare variable $trace external;
          declare variable $extension external;

          xdmp:document-insert(
            "/" || $trace/*:trace/*:traceId || $extension,
            $trace,
            xdmp:default-permissions(),
            ("trace", $trace/*:trace/*:flow-type)
          )
        ',
        map:new((
          map:entry("trace", $trace),
          map:entry("extension", if (rfc:is-json()) then ".json" else ".xml")
        )),
        map:new((
          map:entry("database", xdmp:database($config:TRACE-DATABASE)),
          map:entry("commit", "auto"),
          map:entry("update", "true"),
          map:entry("ignoreAmps", fn:true())
        )))
    )
    else ()
};

declare function trace:sanitize-data($data)
{
  if ($data instance of binary()) then xs:hexBinary($data)
  else if (fn:not(rfc:is-json())) then
    if ($data instance of null-node()) then ()
    else $data
  else $data
};

declare function trace:plugin-trace(
  $output,
  $duration) as empty-sequence()
{
  trace:plugin-trace($rfc:item-context, $output, $duration)
};

declare function trace:plugin-trace(
  $item-context as map:map,
  $output,
  $duration) as empty-sequence()
{
  let $current-trace := rfc:get-trace($item-context)
  let $output := trace:sanitize-data($output)
  return
    if (trace:enabled()) then(
      let $new-step := map:map()
      let $_ := (
        map:put($new-step, "label", get-plugin-label($current-trace)),
        trace:get-plugin-input($current-trace) ! map:put($new-step, "input", .),
        map:put($new-step, "output", $output),
        map:put($new-step, "duration", $duration),
        map:put($new-step, "options", json:object(document { rfc:get-options($item-context) }/node()))
      )
      let $trace-steps := (
        map:get($current-trace, "traceSteps"),
        $new-step
      )
      return
        map:put($current-trace, "traceSteps", $trace-steps)
    )
    else ()
};

declare function trace:error-trace(
  $item-context as map:map,
  $error as element(error:error),
  $duration as xs:dayTimeDuration)
{
  let $current-trace := rfc:get-trace($item-context)
  let $identifier := rfc:get-id($item-context)
  let $_ := trace:increment-error-count()
  let $_ := $identifier ! trace:add-failed-item(.)
  return (
    map:put($current-trace-settings, "_has_errors", fn:true()),
    let $trace-steps := (
      map:get($current-trace, "traceSteps"),
      map:new((
        map:entry("label", get-plugin-label($current-trace)),
        map:entry("input", get-plugin-input($current-trace)),
        map:entry("error",
          if (rfc:is-json()) then
            $error/err:error-to-json(.)
          else
            $error
        ),
        map:entry("duration", $duration),
        map:entry("options", rfc:get-options($item-context))
      ))
    )
    let $_ := map:put($current-trace, "traceSteps", $trace-steps)
    let $_ := trace:write-error-trace($item-context)
    return ()
  )
};

declare function trace:_walk_json($nodes as node()* ,$o)
{
  let $quote-options :=
    <options xmlns="xdmp:quote">
      <indent>yes</indent>
      <indent-untyped>yes</indent-untyped>
      <omit-xml-declaration>yes</omit-xml-declaration>
    </options>

  for $n in $nodes
  return
    typeswitch($n)
      case array-node() return
        let $name as xs:string := fn:string(fn:node-name($n))
        return
          if ($name = "steps") then
            let $a := json:array()
            let $_ :=
              for $value in $n/node()
              let $oo := json:object()
              let $_ := trace:_walk_json($value/node(), $oo)
              return
                json:array-push($a, $oo)
            return
              map:put($o, $name, $a)
          else
            map:put($o, $name, xdmp:quote($n))
      case object-node() return
        let $oo := map:new()
        let $name as xs:string := fn:string(fn:node-name($n))
        return
          if ($name = "input") then
            if ($n/node()) then
              let $_ :=
                for $x in $n/node()
                (: try to unquote xml for formatting :)
                let $unquoted :=
                  if ($x instance of text()) then
                    try {
                      xdmp:quote(xdmp:unquote(fn:string($x)), $quote-options)
                    }
                    catch($ex) {
                      $x
                    }
                  else
                    $x
                let $nn := fn:string(fn:node-name($x))
                return
                  map:put($oo, $nn, $unquoted)
              return
                map:put($o, $name, $oo)
            else
              map:put($o, $name, null-node {})
          else if ($name = "output") then
            (: try to unquote xml for formatting :)
            let $unquoted :=
              if ($n instance of text()) then
                try {
                  xdmp:quote(xdmp:unquote(fn:string($n)), $quote-options)
                }
                catch($ex) {
                  $n
                }
              else
                $n
            return
              map:put($o, $name, $unquoted)
          else if ($name = "error") then
            map:put($o, $name, $n)
          else if ($name = ("collectorPlugin", "contentPlugin", "headersPlugin", "triplesPlugin", "writerPlugin")) then
            ()
          else
            let $_ := trace:_walk_json($n/node(), $oo)
            return
              map:put($o, $name, $oo)
      case number-node() |
           boolean-node() |
           null-node() return
        map:put($o, fn:string(fn:node-name($n)), fn:data($n))
      case text() return
        let $unquoted :=
          try {
            xdmp:quote(xdmp:unquote(fn:string($n)), $quote-options)
          }
          catch($ex) {
            $n
          }
        return
          map:put($o, fn:string(fn:node-name($n)), $unquoted)
      case element(input) return
        let $oo := json:object()
        let $_ :=
          for $x in $n/*
          return
            map:put($oo, fn:local-name($x), xdmp:quote($x/*, $quote-options))
        return
          map:put($o, "input", $oo)
      case element(output) return
        map:put($o, fn:local-name($n), xdmp:quote($n/node(), $quote-options))
      case element(error) return
        map:put($o, fn:local-name($n), $n/error:error/err:error-to-json(.))
      case element(duration) return
        map:put($o, "duration", fn:seconds-from-duration(xs:dayTimeDuration($n)))
      case element(hasError) return
        map:put($o, "hasError", xs:boolean($n))
      case element(steps) return
        let $a := json:array()
        let $_ :=
          for $step in $n/step
          let $oo := json:object()
          let $_ := trace:_walk_json($step/*, $oo)
          return
            json:array-push($a, $oo)
        return
          map:put($o, "steps", $a)
      case element() return
        if ($n/*) then
          let $oo := json:object()
          let $_ := trace:_walk_json($n/*, $oo)
          return
            map:put($o, fn:local-name($n), $oo)
        else
          map:put($o, fn:local-name($n), $n/fn:data(.))
      default return
        $n
};

declare function trace:trace-to-json-legacy($trace)
{
  let $o := json:object()
  let $_ :=
    for $n in $trace/node()
    let $name := fn:string(fn:node-name($n))
    where fn:not($name = ("collectorPlugin", "contentPlugin", "headersPlugin", "triplesPlugin", "writerPlugin"))
    return
      map:put($o, $name, $n/data())
  let $steps := json:array()
  let $_build_steps :=
    for $n in $trace/node()
    let $name := fn:string(fn:node-name($n))
    where $name = ("collectorPlugin", "contentPlugin", "headersPlugin", "triplesPlugin", "writerPlugin")
    return
      let $step := json:object()
      let $_ := map:put($step, "label", fn:replace($name, "Plugin", ""))
      let $_ :=
        trace:_walk_json($n/node(), $step)
      return
        json:array-push($steps, $step)
  let $_ := map:put($o, "steps", $steps)
  return $o
};

declare function trace:trace-to-json($trace)
{
  if (fn:exists($trace/steps) or
      xdmp:node-kind($trace) = "object" and
      fn:exists($trace/trace/steps)) then
    let $o := json:object()
    let $walk-me :=
      let $n := $trace/node()
      return
        if ($n instance of object-node()) then
          $n/node()
        else
          $n
    let $_ := trace:_walk_json($walk-me, $o)
    return
      $o
  else
    trace:trace-to-json-legacy($trace)
};

declare function trace:trace-to-json-slim($trace)
{
  let $o := json:object()
  let $_ := (
    map:put($o, "traceId", $trace/trace/traceId/string()),
    map:put($o, "jobId", $trace/trace/jobId/string()),
    map:put($o, "created", $trace/trace/created/string()),
    map:put($o, "hasError", $trace/trace/hasError/xs:boolean(.)),
    map:put($o, "identifier", $trace/trace/identifier/string()),
    map:put($o, "flowType", $trace/trace/flowType/string()),
    map:put($o, "format", $trace/trace/format/string())
  )
  return
    $o
};

declare function trace:find-traces(
  $q,
  $page as xs:unsignedLong,
  $page-length as xs:unsignedLong)
{
  let $options :=
    <options xmlns="http://marklogic.com/appservices/search">
      <additional-query>{cts:collection-query("trace")}</additional-query>
      <return-results>false</return-results>
      <return-facets>true</return-facets>
      <sort-order type="xs:dateTime"
          direction="descending">
        <path-index>/trace/created</path-index>
      </sort-order>
    </options>
  let $query := search:parse($q)
  let $count := search:estimate($query, $options)
  let $start := ($page - 1) * $page-length + 1
  let $end := fn:min(($start + $page-length - 1, $count))
  let $results :=
    for $result in search:resolve-nodes($query, $options, $start, $page-length)
    return
      trace:trace-to-json-slim($result/node())
  return
    object-node {
      "start": $start,
      "end": $end,
      "total": $count,
      "page": $page,
      "pageCount": $page-length,
      "traces": json:to-array($results)
    }
};

declare function trace:get-traces($page as xs:int, $page-length as xs:int)
{
  let $start := ($page - 1) * $page-length + 1
  let $end := $start + $page-length - 1
  let $count := xdmp:estimate(/trace)
  let $traces :=
    for $trace in cts:search(/trace, cts:true-query(), ("unfiltered", cts:index-order(cts:path-reference("/trace/created"), "descending")))[$start to $end]
    return
      trace:trace-to-json($trace)
  return
    object-node {
      "start": $start,
      "end": $end,
      "total": $count,
      "page": $page,
      "pageCount": $page-length,
      "traces": json:to-array($traces)
    }
};

declare function trace:get-trace($id as xs:string)
{
  let $query :=
    cts:or-query((
      cts:path-range-query("/trace/traceId", "=", $id, ("collation=http://marklogic.com/collation/codepoint"))
    ))
  return
    trace:trace-to-json(cts:search(fn:doc(), $query)[1]/node())
};

declare function trace:get-traceIds($q as xs:string?)
{
  let $query :=
    if ($q) then
      cts:element-value-query(xs:QName("identifier"), fn:lower-case($q) || "*", "wildcarded")
    else ()
  let $results :=
    cts:value-co-occurrences(
      cts:path-reference("/trace/traceId"),
      cts:path-reference("/trace/identifier"),
      (
        "limit=10"
      ),
      $query)
  let $results :=
    for $r in $results
    return
      object-node {
        "traceId": fn:data($r/*:value[1]),
        "identifier": fn:data($r/*:value[2])
      }
  return
    json:to-array($results)
};

(:
  Copyright 2012-2018 MarkLogic Corporation

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

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

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

module namespace trace = "http://marklogic.com/data-hub/trace";

import module namespace config = "http://marklogic.com/data-hub/config"
  at "/com.marklogic.hub/config.xqy";

import module namespace consts = "http://marklogic.com/data-hub/consts"
  at "/MarkLogic/data-hub-framework/impl/consts.xqy";

import module namespace err = "http://marklogic.com/data-hub/err"
  at "/MarkLogic/data-hub-framework/impl/error-lib.xqy";

import module namespace hul = "http://marklogic.com/data-hub/hub-utils-lib"
  at "/MarkLogic/data-hub-framework/impl/hub-utils-lib.xqy";

import module namespace json="http://marklogic.com/xdmp/json"
  at "/MarkLogic/json/json.xqy";

import module namespace rfc = "http://marklogic.com/data-hub/run-flow-context"
  at "/MarkLogic/data-hub-framework/impl/run-flow-context.xqy";

import module namespace search = "http://marklogic.com/appservices/search"
  at "/MarkLogic/appservices/search/search.xqy";

declare option xdmp:mapping "false";

(: new trace-settings are initialized for each transaction :)
declare variable $current-trace-settings := map:map();

declare function trace:new-trace() as map:map
{
  map:new((
    map:entry("traceId", xdmp:random()),
    map:entry("created", fn:current-dateTime())
  ))
};

declare function trace:enable-tracing($enabled as xs:boolean)
{
  xdmp:eval('
    declare namespace trace = "http://marklogic.com/data-hub/trace";
    declare variable $enabled external;
    xdmp:document-insert(
      "/com.marklogic.hub/settings/__tracing_enabled__.xml",
      element trace:is-tracing-enabled { if ($enabled) then 1 else 0 },
      xdmp:default-permissions(),
      "hub-core-module")
    ',
    map:new((map:entry("enabled", $enabled))),
    map:new((map:entry("database", xdmp:modules-database()), map:entry("ignoreAmps", fn:true())))
  ),
  hul:invalidate-field-cache("tracing-enabled")
};

declare function trace:enabled() as xs:boolean
{
  let $key := "tracing-enabled"
  let $flag :=  hul:from-field-cache-or-empty($key, ())
  return
    if (exists($flag)) then
      $flag
    else
      hul:set-field-cache(
        $key,
        xdmp:eval('
          declare namespace trace = "http://marklogic.com/data-hub/trace";
          fn:exists(
            cts:search(
              fn:doc("/com.marklogic.hub/settings/__tracing_enabled__.xml"),
              cts:element-value-query(xs:QName("trace:is-tracing-enabled"), "1", ("exact")),
              ("unfiltered", "score-zero", "unchecked", "unfaceted")
            )
          )
        ',(), map:new(map:entry("database", xdmp:modules-database()))),
        xs:dayTimeDuration("PT1M")
      )
};

declare function trace:has-errors() as xs:boolean
{
  (map:get($current-trace-settings, "_has_errors"), fn:false())[1] eq fn:true()
};

declare %private function trace:increment-error-count()
{
  map:put($current-trace-settings, "error-count", trace:get-error-count() + 1)
};

declare function trace:get-error-count()
{
  (map:get($current-trace-settings, "error-count"), 0)[1]
};

declare %private function trace:add-failed-item($item as xs:string)
{
  json:array-push(trace:get-failed-items(), $item)
};

declare %private function trace:add-completed-item($item as xs:string)
{
  json:array-push(trace:get-completed-items(), $item)
};

declare function trace:set-plugin-label(
  $label as xs:string)
{
  trace:set-plugin-label(
    rfc:get-trace($rfc:item-context),
    $label
  )
};

(:
 : Sets the label of the currently running plugin
 :
 : @param $label - the label of the running plugin
 :)
declare function trace:set-plugin-label(
  $current-trace as map:map,
  $label as xs:string)
{
  map:put($current-trace, "plugin-label", $label)
};

declare function trace:get-plugin-label(
  $current-trace as map:map)
as xs:string
{
  map:get($current-trace, "plugin-label")
};

declare function trace:reset-plugin-input()
{
  trace:reset-plugin-input(rfc:get-trace($rfc:item-context))
};

declare function trace:reset-plugin-input(
  $current-trace as map:map)
{
  map:put($current-trace, "plugin-input", json:object())
};

declare %private function trace:get-plugin-input(
  $current-trace as map:map)
{
  let $o := map:get($current-trace, "plugin-input")
  where fn:exists($o)
  return
    if (rfc:is-json()) then
      let $oo := json:object()
      let $_ :=
        for $key in map:keys($o)
        let $value := map:get($o, $key)
        let $value := trace:sanitize-data($value)
        return
         map:put($oo, $key, $value)
      return $oo
    else
      for $key in map:keys($o)
      return
        element { $key } {
          let $value := map:get($o, $key)
          return
            trace:sanitize-data($value)
        }
};

(:
 : Registers an input with the trace library
 :
 : @param $label - the label of the input being registered
 : @param $input - the value of the input being registered
 :)
declare function trace:set-plugin-input(
  $label as xs:string,
  $input)
{
  trace:set-plugin-input(rfc:get-trace($rfc:item-context), $label, $input)
};

declare function trace:set-plugin-input(
  $current-trace as map:map,
  $label as xs:string,
  $input)
{
  let $existing := (map:get($current-trace, "plugin-input"), json:object())[1]
  let $_ := map:put($existing, $label, $input)
  return
    map:put($current-trace, "plugin-input", $existing)
};

declare function trace:get-completed-items()
{
  if (map:contains($current-trace-settings, "completed-items")) then
    map:get($current-trace-settings, "completed-items")
  else
    let $value := json:array()
    let $_ := map:put($current-trace-settings, "completed-items", $value)
    return
      $value
};

declare function trace:get-failed-items()
{
  if (map:contains($current-trace-settings, "failed-items")) then
    map:get($current-trace-settings, "failed-items")
  else
    let $value := json:array()
    let $_ := map:put($current-trace-settings, "failed-items", $value)
    return
      $value
};

declare function trace:write-trace(
  $item-context as map:map)
{
  let $identifier := rfc:get-id($item-context)
  where $identifier instance of xs:string
  return
    trace:add-completed-item($identifier),
  trace:write-error-trace($item-context)
};

declare %private function trace:write-error-trace(
  $item-context as map:map)
{
  let $current-trace := rfc:get-trace($item-context)
  return
    if (trace:enabled() or trace:has-errors()) then (
      let $trace :=
        if (rfc:is-json()) then
          xdmp:to-json((
            map:entry("trace",
              map:new((
                map:entry("jobId", rfc:get-job-id()),
                map:entry("format", rfc:get-data-format()),
                map:entry("traceId", map:get($current-trace, "traceId")),
                map:entry("created", map:get($current-trace, "created")),
                map:entry("identifier", rfc:get-id($item-context)),
                map:entry("flowType", rfc:get-flow-type()),
                map:entry("hasError", trace:has-errors()),
                let $steps := json:array()
                let $_ :=
                  for $step in map:get($current-trace, "traceSteps")
                  return
                    json:array-push($steps, $step)
                return
                  map:entry("steps", $steps)
              ))
            )
          ))
        else
          document {
            element trace {
              element jobId { rfc:get-job-id() },
              element format { rfc:get-data-format() },
              element traceId { map:get($current-trace, "traceId") },
              element created { map:get($current-trace, "created") },
              element identifier { rfc:get-id($item-context) },
              element flowType { rfc:get-flow-type() },
              element hasError { trace:has-errors() },
              element steps {
                for $step in map:get($current-trace, "traceSteps")
                return
                  element step {
                    element label { map:get($step, "label") },
                    element input { map:get($step, "input") },
                    element output { map:get($step, "output") },
                    element error { map:get($step, "error") },
                    element duration { map:get($step, "duration") },
                    element options { map:get($step, "options") }
                  }
              }
            }
          }
      return
        xdmp:eval('
          xquery version "1.0-ml";

          declare option xdmp:mapping "false";

          declare variable $trace external;
          declare variable $extension external;

          xdmp:document-insert(
            "/" || $trace/*:trace/*:traceId || $extension,
            $trace,
            xdmp:default-permissions(),
            ("trace", $trace/*:trace/*:type)
          )
        ',
        map:new((
          map:entry("trace", $trace),
          map:entry("extension", if (rfc:is-json()) then ".json" else ".xml")
        )),
        map:new((
          map:entry("database", xdmp:database($config:TRACE-DATABASE)),
          map:entry("commit", "auto"),
          map:entry("update", "true"),
          map:entry("ignoreAmps", fn:true())
        )))
    )
    else ()
};

declare function trace:sanitize-data($data)
{
  if ($data instance of binary()) then xs:hexBinary($data)
  else if (fn:not(rfc:is-json())) then
    if ($data instance of null-node()) then ()
    else $data
  else $data
};

declare function trace:plugin-trace(
  $output,
  $duration) as empty-sequence()
{
  trace:plugin-trace($rfc:item-context, $output, $duration)
};

declare function trace:plugin-trace(
  $item-context as map:map,
  $output,
  $duration) as empty-sequence()
{
  let $current-trace := rfc:get-trace($item-context)
  let $output := trace:sanitize-data($output)
  return
    if (trace:enabled()) then(
      let $new-step := map:map()
      let $_ := (
        map:put($new-step, "label", get-plugin-label($current-trace)),
        trace:get-plugin-input($current-trace) ! map:put($new-step, "input", .),
        map:put($new-step, "output", $output),
        map:put($new-step, "duration", $duration),
        map:put($new-step, "options", json:object(document { rfc:get-options($item-context) }/node()))
      )
      let $trace-steps := (
        map:get($current-trace, "traceSteps"),
        $new-step
      )
      return
        map:put($current-trace, "traceSteps", $trace-steps)
    )
    else ()
};

declare function trace:error-trace(
  $item-context as map:map,
  $error as element(error:error),
  $duration as xs:dayTimeDuration)
{
  let $current-trace := rfc:get-trace($item-context)
  let $identifier := rfc:get-id($item-context)
  let $_ := trace:increment-error-count()
  let $_ := $identifier ! trace:add-failed-item(.)
  return (
    map:put($current-trace-settings, "_has_errors", fn:true()),
    let $trace-steps := (
      map:get($current-trace, "traceSteps"),
      map:new((
        map:entry("label", get-plugin-label($current-trace)),
        map:entry("input", get-plugin-input($current-trace)),
        map:entry("error",
          if (rfc:is-json()) then
            $error/err:error-to-json(.)
          else
            $error
        ),
        map:entry("duration", $duration),
        map:entry("options", rfc:get-options($item-context))
      ))
    )
    let $_ := map:put($current-trace, "traceSteps", $trace-steps)
    let $_ := trace:write-error-trace($item-context)
    return ()
  )
};

declare function trace:_walk_json($nodes as node()* ,$o)
{
  let $quote-options :=
    <options xmlns="xdmp:quote">
      <indent>yes</indent>
      <indent-untyped>yes</indent-untyped>
      <omit-xml-declaration>yes</omit-xml-declaration>
    </options>

  for $n in $nodes
  return
    typeswitch($n)
      case array-node() return
        let $name as xs:string := fn:string(fn:node-name($n))
        return
          if ($name = "steps") then
            let $a := json:array()
            let $_ :=
              for $value in $n/node()
              let $oo := json:object()
              let $_ := trace:_walk_json($value/node(), $oo)
              return
                json:array-push($a, $oo)
            return
              map:put($o, $name, $a)
          else
            map:put($o, $name, xdmp:quote($n))
      case object-node() return
        let $oo := map:new()
        let $name as xs:string := fn:string(fn:node-name($n))
        return
          if ($name = "input") then
            if ($n/node()) then
              let $_ :=
                for $x in $n/node()
                (: try to unquote xml for formatting :)
                let $unquoted :=
                  if ($x instance of text()) then
                    try {
                      xdmp:quote(xdmp:unquote(fn:string($x)), $quote-options)
                    }
                    catch($ex) {
                      $x
                    }
                  else
                    $x
                let $nn := fn:string(fn:node-name($x))
                return
                  map:put($oo, $nn, $unquoted)
              return
                map:put($o, $name, $oo)
            else
              map:put($o, $name, null-node {})
          else if ($name = "output") then
            (: try to unquote xml for formatting :)
            let $unquoted :=
              if ($n instance of text()) then
                try {
                  xdmp:quote(xdmp:unquote(fn:string($n)), $quote-options)
                }
                catch($ex) {
                  $n
                }
              else
                $n
            return
              map:put($o, $name, $unquoted)
          else if ($name = "error") then
            map:put($o, $name, $n)
          else if ($name = ("collectorPlugin", "contentPlugin", "headersPlugin", "triplesPlugin", "writerPlugin")) then
            ()
          else
            let $_ := trace:_walk_json($n/node(), $oo)
            return
              map:put($o, $name, $oo)
      case number-node() |
           boolean-node() |
           null-node() return
        map:put($o, fn:string(fn:node-name($n)), fn:data($n))
      case text() return
        let $unquoted :=
          try {
            xdmp:quote(xdmp:unquote(fn:string($n)), $quote-options)
          }
          catch($ex) {
            $n
          }
        return
          map:put($o, fn:string(fn:node-name($n)), $unquoted)
      case element(input) return
        let $oo := json:object()
        let $_ :=
          for $x in $n/*
          return
            map:put($oo, fn:local-name($x), xdmp:quote($x/*, $quote-options))
        return
          map:put($o, "input", $oo)
      case element(output) return
        map:put($o, fn:local-name($n), xdmp:quote($n/node(), $quote-options))
      case element(error) return
        map:put($o, fn:local-name($n), $n/error:error/err:error-to-json(.))
      case element(duration) return
        map:put($o, "duration", fn:seconds-from-duration(xs:dayTimeDuration($n)))
      case element(hasError) return
        map:put($o, "hasError", xs:boolean($n))
      case element(steps) return
        let $a := json:array()
        let $_ :=
          for $step in $n/step
          let $oo := json:object()
          let $_ := trace:_walk_json($step/*, $oo)
          return
            json:array-push($a, $oo)
        return
          map:put($o, "steps", $a)
      case element() return
        if ($n/*) then
          let $oo := json:object()
          let $_ := trace:_walk_json($n/*, $oo)
          return
            map:put($o, fn:local-name($n), $oo)
        else
          map:put($o, fn:local-name($n), $n/fn:data(.))
      default return
        $n
};

declare function trace:trace-to-json-legacy($trace)
{
  let $o := json:object()
  let $_ :=
    for $n in $trace/node()
    let $name := fn:string(fn:node-name($n))
    where fn:not($name = ("collectorPlugin", "contentPlugin", "headersPlugin", "triplesPlugin", "writerPlugin"))
    return
      map:put($o, $name, $n/data())
  let $steps := json:array()
  let $_build_steps :=
    for $n in $trace/node()
    let $name := fn:string(fn:node-name($n))
    where $name = ("collectorPlugin", "contentPlugin", "headersPlugin", "triplesPlugin", "writerPlugin")
    return
      let $step := json:object()
      let $_ := map:put($step, "label", fn:replace($name, "Plugin", ""))
      let $_ :=
        trace:_walk_json($n/node(), $step)
      return
        json:array-push($steps, $step)
  let $_ := map:put($o, "steps", $steps)
  return $o
};

declare function trace:trace-to-json($trace)
{
  if (fn:exists($trace/steps) or
      xdmp:node-kind($trace) = "object" and
      fn:exists($trace/trace/steps)) then
    let $o := json:object()
    let $walk-me :=
      let $n := $trace/node()
      return
        if ($n instance of object-node()) then
          $n/node()
        else
          $n
    let $_ := trace:_walk_json($walk-me, $o)
    return
      $o
  else
    trace:trace-to-json-legacy($trace)
};

declare function trace:trace-to-json-slim($trace)
{
  let $o := json:object()
  let $_ := (
    map:put($o, "traceId", $trace/trace/traceId/string()),
    map:put($o, "jobId", $trace/trace/jobId/string()),
    map:put($o, "created", $trace/trace/created/string()),
    map:put($o, "hasError", $trace/trace/hasError/xs:boolean(.)),
    map:put($o, "identifier", $trace/trace/identifier/string()),
    map:put($o, "flowType", $trace/trace/flowType/string()),
    map:put($o, "format", $trace/trace/format/string())
  )
  return
    $o
};

declare function trace:find-traces(
  $q,
  $page as xs:unsignedLong,
  $page-length as xs:unsignedLong)
{
  let $options :=
    <options xmlns="http://marklogic.com/appservices/search">
      <additional-query>{cts:collection-query("trace")}</additional-query>
      <return-results>false</return-results>
      <return-facets>true</return-facets>
      <sort-order type="xs:dateTime"
          direction="descending">
        <path-index>/trace/created</path-index>
      </sort-order>
    </options>
  let $query := search:parse($q)
  let $count := search:estimate($query, $options)
  let $start := ($page - 1) * $page-length + 1
  let $end := fn:min(($start + $page-length - 1, $count))
  let $results :=
    for $result in search:resolve-nodes($query, $options, $start, $page-length)
    return
      trace:trace-to-json-slim($result/node())
  return
    object-node {
      "start": $start,
      "end": $end,
      "total": $count,
      "page": $page,
      "pageCount": $page-length,
      "traces": json:to-array($results)
    }
};

declare function trace:get-traces($page as xs:int, $page-length as xs:int)
{
  let $start := ($page - 1) * $page-length + 1
  let $end := $start + $page-length - 1
  let $count := xdmp:estimate(/trace)
  let $traces :=
    for $trace in cts:search(/trace, cts:true-query(), ("unfiltered", cts:index-order(cts:path-reference("/trace/created"), "descending")))[$start to $end]
    return
      trace:trace-to-json($trace)
  return
    object-node {
      "start": $start,
      "end": $end,
      "total": $count,
      "page": $page,
      "pageCount": $page-length,
      "traces": json:to-array($traces)
    }
};

declare function trace:get-trace($id as xs:string)
{
  let $query :=
    cts:or-query((
      cts:path-range-query("/trace/traceId", "=", $id, ("collation=http://marklogic.com/collation/codepoint"))
    ))
  return
    trace:trace-to-json(cts:search(fn:doc(), $query)[1]/node())
};

declare function trace:get-traceIds($q as xs:string?)
{
  let $query :=
    if ($q) then
      cts:element-value-query(xs:QName("identifier"), fn:lower-case($q) || "*", "wildcarded")
    else ()
  let $results :=
    cts:value-co-occurrences(
      cts:path-reference("/trace/traceId"),
      cts:path-reference("/trace/identifier"),
      (
        "limit=10"
      ),
      $query)
  let $results :=
    for $r in $results
    return
      object-node {
        "traceId": fn:data($r/*:value[1]),
        "identifier": fn:data($r/*:value[2])
      }
  return
    json:to-array($results)
};


Remove the unused err:module node from the local:error return value.

(:
 : 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 ($mode eq "validate") then
            <static-check>true</static-check>
        else
            (),
        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) and $mimetype eq "application/xquery") 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:additional as element(error:error)) {
    <err:error xmlns:dbg="http://reecedunn.co.uk/xquery/debug">
        <err:code>{
            let $code := $err:additional/error:code/text()
            return if (exists($code) and not(starts-with($code, "XDMP-"))) then $code else "err:XPST0003"
        }</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>
        <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")
            let $start := xdmp:elapsed-time()
            let $ret := $f($query, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        default return ()
    else
        switch ($mode)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:invoke($module-path, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        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
        let $start := xdmp:elapsed-time()
        let $ret := sem:sparql($query, $variables)
        return (xdmp:elapsed-time() - $start, $ret)
    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
        let $start := xdmp:elapsed-time()
        let $ret := sem:sparql-update($query, $variables)
        return (xdmp:elapsed-time() - $start, $ret)
    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")
            let $start := xdmp:elapsed-time()
            let $ret := $f($query)
            return (xdmp:elapsed-time() - $start, $ret)
        else
            let $f := local:function("xdmp:sql#3")
            let $start := xdmp:elapsed-time()
            let $ret := $f($query, (), $variables)
            return (xdmp:elapsed-time() - $start, $ret)
    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 "profile" return prof:eval($query, $variables, $options)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:eval($query, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp:eval($query, $variables, $options)
        default return ()
    else
        switch ($mode)
        case "profile" return prof:invoke($module-path, $variables, $options)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:invoke($module-path, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp: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 "profile" return prof:xslt-eval(xdmp:unquote($query), $input, $variables, $options)
        case "run" return
            let $query := xdmp:unquote($query)
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:xslt-eval($query, $input, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp:xslt-eval(xdmp:unquote($query), $input, $variables, $options)
        default return ()
    else
        switch ($mode)
        case "profile" return prof:xslt-invoke($module-path, $input, $variables, $options)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:xslt-invoke($module-path, $input, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp: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: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: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 ($mode eq "validate") then
            <static-check>true</static-check>
        else
            (),
        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) and $mimetype eq "application/xquery") 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: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>{
            let $code := $err:additional/error:code/text()
            return if (exists($code) and not(starts-with($code, "XDMP-"))) then $code else "err:XPST0003"
        }</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")
            let $start := xdmp:elapsed-time()
            let $ret := $f($query, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        default return ()
    else
        switch ($mode)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:invoke($module-path, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        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
        let $start := xdmp:elapsed-time()
        let $ret := sem:sparql($query, $variables)
        return (xdmp:elapsed-time() - $start, $ret)
    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
        let $start := xdmp:elapsed-time()
        let $ret := sem:sparql-update($query, $variables)
        return (xdmp:elapsed-time() - $start, $ret)
    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")
            let $start := xdmp:elapsed-time()
            let $ret := $f($query)
            return (xdmp:elapsed-time() - $start, $ret)
        else
            let $f := local:function("xdmp:sql#3")
            let $start := xdmp:elapsed-time()
            let $ret := $f($query, (), $variables)
            return (xdmp:elapsed-time() - $start, $ret)
    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 "profile" return prof:eval($query, $variables, $options)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:eval($query, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp:eval($query, $variables, $options)
        default return ()
    else
        switch ($mode)
        case "profile" return prof:invoke($module-path, $variables, $options)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:invoke($module-path, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp: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 "profile" return prof:xslt-eval(xdmp:unquote($query), $input, $variables, $options)
        case "run" return
            let $query := xdmp:unquote($query)
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:xslt-eval($query, $input, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp:xslt-eval(xdmp:unquote($query), $input, $variables, $options)
        default return ()
    else
        switch ($mode)
        case "profile" return prof:xslt-invoke($module-path, $input, $variables, $options)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:xslt-invoke($module-path, $input, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp: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:module, $err:line-number, $err:column-number, $err:additional)
}


Annotate the BaseX archive functions with versioned type restrictions.

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

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

declare option o:requires "basex/7.3";

declare %a:since("basex", "7.3") function archive:create($entries as item(), $contents as item()*) as xs:base64Binary external;
declare %a:since("basex", "7.3") function archive:create($entries as item(), $contents as item()*, $options as map(*)?) as xs:base64Binary external;
declare %a:since("basex", "8.3") function archive:create-from($path as xs:string) as xs:base64Binary external;
declare %a:since("basex", "8.3") function archive:create-from($path as xs:string, $options as map(*)?) as xs:base64Binary external;
declare %a:since("basex", "8.3") function archive:create-from($path as xs:string, $options as map(*)?, $entries as item()*) as xs:base64Binary external;
declare %a:since("basex", "7.3") function archive:entries($archive as xs:base64Binary) as element(archive:entry)* external;
declare %a:restrict-until("return", "basex", "8.5", "element(archive:options)")
        %a:restrict-since("return", "basex", "8.5", "map(*)")
        %a:since("basex", "7.3") function archive:options($archive as xs:base64Binary) as (element(archive:options)|map(*)) external;
declare %a:since("basex", "7.3") function archive:extract-text($archive as xs:base64Binary) as xs:string* external;
declare %a:since("basex", "7.3") function archive:extract-text($archive as xs:base64Binary, $entries as item()*) as xs:string* external;
declare %a:since("basex", "7.3") function archive:extract-text($archive as xs:base64Binary, $entries as item()*, $encoding as xs:string) as xs:string* external;
declare %a:since("basex", "7.3") function archive:extract-binary($archive as xs:base64Binary) as xs:base64Binary* external;
declare %a:since("basex", "7.3") function archive:extract-binary($archive as xs:base64Binary, $entries as item()*) as xs:base64Binary* external;
declare %a:since("basex", "8.3") function archive:extract-to($path as xs:string, $archive as xs:base64Binary) as empty-sequence() external;
declare %a:since("basex", "8.3") function archive:extract-to($path as xs:string, $archive as xs:base64Binary, $entries as item()*) as empty-sequence() external;
declare %a:since("basex", "7.3") function archive:update($archive as xs:base64Binary, $entries as item()*, $contents as item()*) as xs:base64Binary external;
declare %a:since("basex", "7.3") function archive:delete($archive as xs:base64Binary, $entries as item()*) as xs:base64Binary external;
declare %a:since("basex", "7.7") %a:until("basex", "8.3", "archive:create-from#2", "archive:extract-to#1") function archive:write($path as xs:string, $archive as xs:base64Binary) as empty-sequence() external;
declare %a:since("basex", "7.7") %a:until("basex", "8.3", "archive:create-from#3", "archive:extract-to#2") function archive:write($path as xs:string, $archive as xs:base64Binary, $entries as item()*) as empty-sequence() external;

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

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

declare option o:requires "basex/7.3";

declare %a:since("basex", "7.3") function archive:create($entries as item(), $contents as item()*) as xs:base64Binary external;
declare %a:since("basex", "7.3") function archive:create($entries as item(), $contents as item()*, $options as map(*)?) as xs:base64Binary external;
declare %a:since("basex", "8.3") function archive:create-from($path as xs:string) as xs:base64Binary external;
declare %a:since("basex", "8.3") function archive:create-from($path as xs:string, $options as map(*)?) as xs:base64Binary external;
declare %a:since("basex", "8.3") function archive:create-from($path as xs:string, $options as map(*)?, $entries as item()*) as xs:base64Binary external;
declare %a:since("basex", "7.3") function archive:entries($archive as xs:base64Binary) as element(archive:entry)* external;
declare %a:since("basex", "7.3") function archive:options($archive as xs:base64Binary) (: as [7.3]element(archive:options) [8.5]map(*) :) external;
declare %a:since("basex", "7.3") function archive:extract-text($archive as xs:base64Binary) as xs:string* external;
declare %a:since("basex", "7.3") function archive:extract-text($archive as xs:base64Binary, $entries as item()*) as xs:string* external;
declare %a:since("basex", "7.3") function archive:extract-text($archive as xs:base64Binary, $entries as item()*, $encoding as xs:string) as xs:string* external;
declare %a:since("basex", "7.3") function archive:extract-binary($archive as xs:base64Binary) as xs:base64Binary* external;
declare %a:since("basex", "7.3") function archive:extract-binary($archive as xs:base64Binary, $entries as item()*) as xs:base64Binary* external;
declare %a:since("basex", "8.3") function archive:extract-to($path as xs:string, $archive as xs:base64Binary) as empty-sequence() external;
declare %a:since("basex", "8.3") function archive:extract-to($path as xs:string, $archive as xs:base64Binary, $entries as item()*) as empty-sequence() external;
declare %a:since("basex", "7.3") function archive:update($archive as xs:base64Binary, $entries as item()*, $contents as item()*) as xs:base64Binary external;
declare %a:since("basex", "7.3") function archive:delete($archive as xs:base64Binary, $entries as item()*) as xs:base64Binary external;
declare %a:since("basex", "7.7") %a:until("basex", "8.3", "archive:create-from#2", "archive:extract-to#1") function archive:write($path as xs:string, $archive as xs:base64Binary) as empty-sequence() external;
declare %a:since("basex", "7.7") %a:until("basex", "8.3", "archive:create-from#3", "archive:extract-to#2") function archive:write($path as xs:string, $archive as xs:base64Binary, $entries as item()*) as empty-sequence() external;


Adding vowels to affiliation search strings

(: Creates search strings for macro-affiliations to use in Voyant Tools :)

(: The labels to append to each item in $search-strings :)
let $search-labels := (
'Muslim',
'Christian',
'Jewish',
'Zoroastrian',
'Sabian',
'Zindiq'
 (:Removing conversion labels from search strings, since these are of a different nature, and need different methods to identify, being
 verbs and verbal phrases. (Voyant does not seem to handle phrases containing wildcards.):)
(:,
'Convert-to-Islam':)
)

let $search-strings := (
'حَنَفِ*|أَحْنَاف*|زَيدِي*|زُيُود*|سُنِّي*|أَنْصَرِي*|أَنْصَارِي*|عَلَوِي*|خَارِجِي*|خَوَارِج*|صَحَابِي*|صَحَابَة*|إِمَامِي*|مَالِكِي*|شَافِعِي*|مُعْتَزِل*|صُوفِي*|حَنْبَل*|مُرْجِي*|أَشْعَرِ*|أَشَاعِرَة*|شِيع*|أَشْيَاع*|رافض*|أَرْفَاض*',
'مَسِيح*|نُسْطُور*|نَسَاطِرَة*|نَصْرَان*|نَصَارَى*|رَاهِب*|رُهْبَان*|سُرْيَانِي*'
,'يَهُود*|إِسْرَائِيلِي*'
,'مَجُوس*'
,'صَابِئ*'
,'زِنْدِيق*|زَنَادِق*|زَنَادِيق*'
 (:Removing conversion labels.:)
(:,
'اسلم*|*عتنق* الإسلام':)
)

let $prefixes := ('ب','ل','ك','ف','و')

(: If turned on will only search for variants that include any shaddas in above strings. :)
let $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. :)
let $require-existing-vowels := 0
(: If turned on will add a search term with the definite article prefixed to the word. :)
let $add-optional-article := 1
(: If turned on will add attached prepositions and conjunctions as optional search strings. :)
let $add-optional-prefixes := 1

for $string at $i in $search-strings
let $existing-vowels :=
    if ($require-existing-vowels) then
        if ($require-existing-shadda) then
            replace(replace($string, '([ً-ِْ-ٖ])','ّ?$1ّ?'),'(ّّ\?([ً-ِْ-ٖ])ّ\?)|(ّ\?([ً-ِْ-ٖ])ّ\?ّ)','(ّ$2$4)|($2$4ّ)') (: optional shadda before / after required vowel, but keeps existing shaddas by replacing optional shaddas with required :)
        else
            replace(replace($string, '([ً-ِْ-ٖ])','ّ?$1ّ?'),'(ّّ\?)|(ّ\?ّ)','ّ?') (: optional shadda before / after required vowel, ignoring existing shaddas by removing duplicate shaddas :)
    else
        if ($require-existing-shadda) then
            replace(replace($string, '([ً-ِْ-ٖ])','$1?'),'(ّ([ً-ِْ-ٖ]\?))|(([ً-ِْ-ٖ]\?)ّ)','($2$4ّ)|(ّ$2$4)') (: optional existing vowel + required shadda on either side :)
        else
            replace(replace($string, '([ً-ٖ])','[ّ$1]*'),'ّ?(\[ّ[ً-ٖ]\]\*)ّ?','$1') (: optional existing vowel + optional shadda, in any order, replacing existing shaddas :)

let $add-vowels :=
    if ($require-existing-shadda) then
        replace(
            replace(
                replace(
                    $existing-vowels,
                    '([ء-ي])(ّ?)',
                    '$1$2[ً-ِْ-ٖ]*') (: Adds vowel wildcard after all consonants :)
                ,'\[ً-ِْ-ٖ\]\*([ً-ِْ-ٖ])'
                ,'$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(
                $existing-vowels,
                '([ء-ي])',
                '$1[ً-ٖ]*') (: Adds vowel wildcard after all consonants :)
            ,'\[ً-ٖ\]\*([\(ّ])'
            ,'$1') (: Then removes wildcard if it is next to an existing vowel-shadda combo. :)

let $remove-final-vowel := (: Removes final vowel because it confuses Voyant Tools. :)
    replace(
        replace($add-vowels,
        '\[ً-ٖ\]\*(\*?)($|\|)',
        '$1$2'),
    '\[ً-ِْ-ٖ\]\*(\*?)($|\|)',
    '$1$2')

let $add-article :=
    if ($add-optional-article) then
     (: Duplicates each segment of the search string, adding the article on the front of one.
     Then removes any back-to-back | characters created in the process. :)
        replace(
            replace($remove-final-vowel,'(.*?[\|$])','$1|الْ?$1'),
            '\|\|',
            '|')
    else $remove-final-vowel

let $add-prefixes :=
    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($add-article,'\|'),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 replace(
            replace(
                $prefixes-added,
                concat('((',$prefixes-to-add,')(الْ\?)(.*?[\|$]))'),
                '$1|لِ?لْ?$4'),
            '\|\|',
            '|')
    else $add-article

let $normalize-alif := replace($add-prefixes,'ا','[آاإأ]')
let $normalize-ya := replace($normalize-alif,'ى','[يىئ]')
let $normalize-waw := replace($normalize-ya,'و','[وؤ]')

return (concat($search-labels[$i],': '),$normalize-waw,'
')

(: Creates search strings for macro-affiliations to use in Voyant Tools :)

(: The labels to append to each item in $search-strings :)
let $search-labels := (
'Muslim',
'Christian',
'Jewish',
'Zoroastrian',
'Sabian',
'Zindiq'
 (:Removing conversion labels from search strings, since these are of a different nature, and need different methods to identify, being
 verbs and verbal phrases. (Voyant does not seem to handle phrases containing wildcards.):)
(:,
'Convert-to-Islam':)
)

let $search-strings := (
'حنف*|زيدي*|السنّي*|أنصاري*|خارجي*|صحابي*|إمامي*|مالكي*|شافع*|معتزل*|صوفي*|حنبل*|مرجئ*|أشعر*|علوي*|شيع*|رافض*',
'مسيح*|نسطور*|نصران*|نصارى*|راهب*|سرياني*'
,'يهود*|إسرائيلي*'
,'مجوس*'
,'صابئ*'
,'زنديق*'
 (:Removing conversion labels.:)
(:,
'اسلم*|*عتنق* الإسلام':)
)

let $prefixes := ('ب','ل','ك','ف','و')

(: If turned on will only search for variants that include any shaddas in above strings. :)
let $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. :)
let $require-existing-vowels := 0
(: If turned on will add a search term with the definite article prefixed to the word. :)
let $add-optional-article := 1
(: If turned on will add attached prepositions and conjunctions as optional search strings. :)
let $add-optional-prefixes := 1

for $string at $i in $search-strings
let $existing-vowels :=
    if ($require-existing-vowels) then
        if ($require-existing-shadda) then
            replace(replace($string, '([ً-ِْ-ٖ])','ّ?$1ّ?'),'(ّّ\?([ً-ِْ-ٖ])ّ\?)|(ّ\?([ً-ِْ-ٖ])ّ\?ّ)','(ّ$2$4)|($2$4ّ)') (: optional shadda before / after required vowel, but keeps existing shaddas by replacing optional shaddas with required :)
        else
            replace(replace($string, '([ً-ِْ-ٖ])','ّ?$1ّ?'),'(ّّ\?)|(ّ\?ّ)','ّ?') (: optional shadda before / after required vowel, ignoring existing shaddas by removing duplicate shaddas :)
    else
        if ($require-existing-shadda) then
            replace(replace($string, '([ً-ِْ-ٖ])','$1?'),'(ّ([ً-ِْ-ٖ]\?))|(([ً-ِْ-ٖ]\?)ّ)','($2$4ّ)|(ّ$2$4)') (: optional existing vowel + required shadda on either side :)
        else
            replace(replace($string, '([ً-ٖ])','[ّ$1]*'),'ّ?(\[ّ[ً-ٖ]\]\*)ّ?','$1') (: optional existing vowel + optional shadda, in any order, replacing existing shaddas :)

let $add-vowels :=
    if ($require-existing-shadda) then
        replace(
            replace(
                replace(
                    $existing-vowels,
                    '([ء-ي])(ّ?)',
                    '$1$2[ً-ِْ-ٖ]*') (: Adds vowel wildcard after all consonants :)
                ,'\[ً-ِْ-ٖ\]\*([ً-ِْ-ٖ])'
                ,'$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(
                $existing-vowels,
                '([ء-ي])',
                '$1[ً-ٖ]*') (: Adds vowel wildcard after all consonants :)
            ,'\[ً-ٖ\]\*([\(ّ])'
            ,'$1') (: Then removes wildcard if it is next to an existing vowel-shadda combo. :)

let $remove-final-vowel := (: Removes final vowel because it confuses Voyant Tools. :)
    replace(
        replace($add-vowels,
        '\[ً-ٖ\]\*(\*?)($|\|)',
        '$1$2'),
    '\[ً-ِْ-ٖ\]\*(\*?)($|\|)',
    '$1$2')

let $add-article :=
    if ($add-optional-article) then
     (: Duplicates each segment of the search string, adding the article on the front of one.
     Then removes any back-to-back | characters created in the process. :)
        replace(
            replace($remove-final-vowel,'(.*?[\|$])','$1|الْ?$1'),
            '\|\|',
            '|')
    else $remove-final-vowel

let $add-prefixes :=
    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($add-article,'\|'),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 replace(
            replace(
                $prefixes-added,
                concat('((',$prefixes-to-add,')(الْ\?)(.*?[\|$]))'),
                '$1|لِ?لْ?$4'),
            '\|\|',
            '|')
    else $add-article

let $normalize-alif := replace($add-prefixes,'ا','[آاإأ]')
let $normalize-ya := replace($normalize-alif,'ى','[يىئ]')
let $normalize-waw := replace($normalize-ya,'و','[وؤ]')

return (concat($search-labels[$i],': '),$normalize-waw,'
')