DHFPROD-1131 fix to get tests green (#1209)

(:
  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 service = "http://marklogic.com/rest-api/extensions/scaffold-content";

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

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

import module namespace functx = "http://www.functx.com"
at "/MarkLogic/functx/functx-1.0-nodoc-2007-01.xqy";

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

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

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

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

declare namespace rapi = "http://marklogic.com/rest-api";

declare option xdmp:mapping "false";

declare function service:comment-xqy($comment-text as xs:string*)
{
  "(: " || fn:string-join($comment-text, "
     ") || " :)"
};

declare function service:comment-sjs($comment-text as xs:string*)
{
  "/* " || fn:string-join($comment-text, "
     ") || " */"
};

declare function service:kebob-case($str as xs:string)
{
  fn:lower-case(fn:replace(fn:replace($str, "([A-Z])", "-$1"), "^-", ""))
};

declare function service:camel-case($str as xs:string)
{
  fn:string-join(
    let $tokens := fn:tokenize($str, "[-_]")
    return
      (
        $tokens[1],
        for $x in fn:subsequence($tokens, 2)
        return
          functx:capitalize-first($x)
      ),
    "")
};

declare function service:get-property($root as xs:string, $property as xs:string)
{
  if (fn:contains($property, "-")) then
    $root || "['" || $property || "']"
  else
    $root || "." || $property
};

declare function service:casting-function-name-xqy(
  $datatype as xs:string
) as xs:string
{
  if ($datatype eq "iri")
  then "sem:iri"
  else "xs:" || $datatype
};

declare function service:casting-function-name-sjs(
  $datatype as xs:string
) as xs:string
{
  if ($datatype eq "iri")
  then "sem.iri"
  else "xs." || $datatype
};

declare function service:generate-lets($model as map:map, $entity-type-name, $mapping as map:map?, $parent-entity as xs:string)
{
  fn:string-join(
    let $definitions := map:get($model, "definitions")
    let $entity-type := map:get($definitions, $entity-type-name)
    let $properties := map:get($entity-type, "properties")
    let $required-properties := (
      map:get($entity-type, "primaryKey"),
      map:get($entity-type, "required") ! json:array-values(.)
    )
    for $property-name in map:keys($properties)
    let $is-required := $property-name = $required-properties
    let $property := map:get($properties, $property-name)
    let $is-array := map:get($property, "datatype") eq "array"
    let $property := map:get($properties, $property-name)
    let $property-datatype := esi:resolve-datatype($model, $entity-type-name, $property-name)
    let $casting-function-name :=
      if (map:contains($property, "datatype") and map:get($property, "datatype") ne "array") then
        service:casting-function-name-xqy($property-datatype)
      else ()
    let $wrap-if-array := function($str) {
      if ($is-array) then
        "json:to-array(" || $str || ")"
      else
        $str
    }
    let $ref :=
      if ($is-array) then
        let $items as map:map? := map:get($property, "items")
        return
          $items ! map:get(., "$ref")
      else
        map:get($property, "$ref")
    let $path-to-property := fn:concat("$source-node/", $property-name)
    let $property-comment :=
      if (fn:empty($ref)) then ()
      else if (fn:contains($ref, "#/definitions")) then
        service:comment-xqy("The following property is a local reference.")
      else (
          service:comment-xqy((
            'The following property assigment comes from an external reference.',
            'Its generated value probably requires developer attention.'
          ))
        )
    let $ref-name := functx:substring-after-last($ref, "/")
    let $extract-reference-fn :=
      fn:string-join((
        "",
        "    plugin:make-reference-object('" || $ref-name || "', (: put your value here :) '')"
      ), "
")
    let $value :=
      if (empty($ref)) then (
        if(service:mapping-present($mapping, $property-name) and $parent-entity eq $entity-type-name)
        then (fn:concat("$source",service:map-value($property-name, $mapping)))
        else ($wrap-if-array(fn:concat("$source/", $property-name))))
      else if (contains($ref, "#/definitions")) then
        let $inner-var := "$" || fn:lower-case($ref-name) || "s"
        let $inner-val :=
          if(service:mapping-present($mapping, $property-name))
          then (fn:concat("$source",service:map-value($property-name, $mapping)))
          else (fn:concat("$source/", $property-name))
        return
          fn:string-join((
            "",
            "let " || $inner-var || " :=",
            "  (: create a sequence of " || $ref-name || " instances from your data :)",
            "  for $sub-entity in ("||$inner-val||")",
            "  return",
            "    plugin:extract-instance-" || $ref-name || "($sub-entity)",
            "return",
            if ($is-required) then
              "  json:to-array(" || $inner-var || ")"
            else (
              "  if (fn:exists(" || $inner-var || ")) then",
              "    json:to-array(" || $inner-var || ")",
              "  else ()"
            )
          ), "
    ") || "
"
      else if(fn:not(empty($ref))) then
           fn:concat("$source/", $property-name)
      else $wrap-if-array($extract-reference-fn)

    return (
      $property-comment ! ("", .),

      let $name := service:kebob-case($property-name)
      let $valueWrap := fn:concat(fn:string-join(
        if ($casting-function-name) then
          $casting-function-name else ())
        , fn:concat(
          "(", $value,")"))
      return
        "let $" || $name || " := " || $valueWrap
    )
    , "
  ")
(: end code generation block :)
};

declare function service:generate-xqy($entity as xs:string, $flow-type as xs:string, $model as map:map, $mapping as map:map?)
{
  let $root-name :=
    if ($flow-type eq $consts:INPUT_FLOW) then "$raw-content"
    else "$doc"
  return
    document {
<module>xquery version "1.0-ml";

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

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

declare option xdmp:mapping "false";

(:~
: Create Content Plugin
:
: @param $id          - the identifier returned by the collector
: @param $options     - a map containing options. Options are sent from Java
:
: @return - your transformed content
:)
declare function plugin:create-content(
  $id as xs:string,
  {
    if ($flow-type eq $consts:INPUT_FLOW) then
      "$raw-content as node()?,
  "
    else ()
  }$options as map:map) as map:map
{{
  {
    if ($flow-type eq $consts:HARMONIZE_FLOW) then
      "let $doc := fn:doc($id)
  "
    else ()
  }let $source := {$root-name}
  return
  {
    "plugin:extract-instance-" || $entity || "($source)"
  }
}};
  {
for $entity-type-name in map:keys(map:get($model, "definitions"))
return
<extract-instance>
(:~
: Creates a map:map instance from some source document.
: @param $source-node  A document or node that contains
:   data for populating a {$entity-type-name}
: @return A map:map instance with extracted data and
:   metadata about the instance.
:)
declare function plugin:extract-instance-{$entity-type-name}(
$source as node()?
) as map:map
{{
{
  if ($entity-type-name eq $entity) then
  <txt>
  (: the original source documents :)
  let $attachments := $source
  let $source      :=
    if ($source/*:envelope and $source/node() instance of element()) then
      $source/*:envelope/*:instance/node()
    else if ($source/*:envelope) then
      $source/*:envelope/*:instance
    else if ($source/instance) then
      $source/instance
    else
      $source
  </txt>/text()
  else (<txt>
  let $source :=
    if($source/node() instance of element()) then
    $source/node()
  else (
    $source
  )
  </txt>/text()
  )
}
{
  if ($entity eq $entity-type-name and fn:empty($mapping) eq fn:false() and fn:empty(map:get($mapping, "name")) eq fn:false()) then
  <txt>(: These mappings were generated using mapping: {map:get($mapping, "name")}, version: {map:get($mapping, "version")} on {fn:current-dateTime()}. :)
  </txt>/text()
  else ()
}
{
service:generate-lets($model, $entity-type-name, $mapping, $entity)
}

  (: return the in-memory instance :)
  (: using the XQuery 3.0 syntax... :)
  let $model := json:object()
  let $_ := (
  {
    if ($entity-type-name eq $entity) then
      "  map:put($model, '$attachments', $attachments),"
    else ()
  }
    map:put($model, '$type', '{ $entity-type-name }'),
    map:put($model, '$version', '{ map:get(map:get($model, "info"), "version") }'){
  let $definitions := map:get($model, "definitions")
  let $entity-type := map:get($definitions, $entity-type-name)
  let $properties := map:get($entity-type, "properties")
  let $property-keys := map:keys($properties)
  where fn:count($property-keys) > 0
  return
    ",
" ||
    fn:string-join(
      (: Begin code generation block :)
      let $required-properties := (
        map:get($entity-type, "primaryKey"),
        map:get($entity-type, "required") ! json:array-values(.)
      )
      for $property-name in $property-keys
      let $is-required := $property-name = $required-properties
      return
        "    map:put($model, '" || $property-name || "', $" || service:kebob-case($property-name) || ")"
      , ",
")
  (: end code generation block :)
  }
  )

  (: if you prefer the xquery 3.1 version with the => operator....
  https://www.w3.org/TR/xquery-31/#id-arrow-operator
  let $model :=
  json:object()
  {
  if ($entity-type-name eq $entity) then
    "  =>map:with('$attachments', $attachments)"
  else ()
  }
    =>map:with('$type', '{ $entity-type-name }')
    =>map:with('$version', '{ map:get(map:get($model, "info"), "version") }')
  {
  fn:string-join(
    (: Begin code generation block :)
    let $definitions := map:get($model, "definitions")
    let $entity-type := map:get($definitions, $entity-type-name)
    let $properties := map:get($entity-type, "properties")
    let $required-properties := (
      map:get($entity-type, "primaryKey"),
      json:array-values(map:get($entity-type, "required"))
    )
    for $property-name in map:keys($properties)
    let $is-required := $property-name = $required-properties
    return
      if ($is-required) then
        "  =>map:with('" || $property-name || "', $" || service:kebob-case($property-name) || ")"
      else
        "    =>es:optional('" || $property-name || "', $" || service:kebob-case($property-name) || ")"
    , "
")
  (: end code generation block :)
  }
  :)
  return $model
}};
</extract-instance>/text()
  }
declare function plugin:make-reference-object(
$type as xs:string,
$ref as xs:string)
{{
  let $o := json:object()
  let $_ := (
    map:put($o, '$type', $type),
    map:put($o, '$ref', $ref)
  )
  return
  $o
}};</module>/text()
}
};

declare function service:generate-vars($model as map:map, $entity-type-name, $mapping as map:map?, $parent-entity as xs:string)
{
  fn:string-join(
    let $definitions := map:get($model, "definitions")
    let $entity-type := map:get($definitions, $entity-type-name)
    let $properties := map:get($entity-type, "properties")
    let $required-properties := (
      map:get($entity-type, "primaryKey"),
      map:get($entity-type, "required") ! json:array-values(.)
    )
    for $property-name in map:keys($properties)
    let $is-required := $property-name = $required-properties

    let $property := map:get($properties, $property-name)
    let $is-array := map:get($property, "datatype") eq "array"
    let $property-datatype := esi:resolve-datatype($model, $entity-type-name, $property-name)
    let $casting-function-name := service:casting-function-name-sjs($property-datatype)
    let $wrap-if-array := function($str) {
      if ($is-array) then
        "json:to-array(" || $str || ")"
      else
        $str
    }
    let $ref :=
      if ($is-array) then
        let $items as map:map? := map:get($property, "items")
        return
          $items ! map:get(., "$ref")
      else
        map:get($property, "$ref")
    let $path-to-property :=
      if (service:mapping-present($mapping, $property-name) and $parent-entity eq $entity-type-name) then (fn:concat("source.xpath('",service:map-value($property-name, $mapping), "')"))  else (fn:concat("source.xpath('/", $property-name, "')"))
    let $property-comment :=
      if (fn:empty($ref)) then ()
      else if (fn:contains($ref, "#/definitions")) then
        service:comment-sjs("The following property is a local reference.")
      else (
          service:comment-sjs((
            'The following property assigment comes from an external reference.',
            'Its generated value probably requires developer attention.'
          ))
        )
    let $ref-name := functx:substring-after-last($ref, "/")
    (:    let $extract-reference-fn :=
      fn:string-join((
        " {",
        "    '$type': '" || $ref-name || "',",
        "    '$ref': " || service:get-property($path-to-property, $ref-name),
        "  }"
      ), "
"):)
    let $value :=
      if (empty($ref)) then
        "!fn.empty(" || $path-to-property || ") ? " || (
        if($is-array) then
          $path-to-property || " : []"
        else
        $casting-function-name || "("
        || "fn.head(" ||
        $path-to-property ||
        (
          if ($property-datatype eq "iri") then
            ".toString()"
          else
            ()
        ) ||
        ")) : null"
        )
      else if (contains($ref, "#/definitions")) then
        if ($is-array) then
          fn:string-join((
            "[];",
            "if(" || $path-to-property || ") {",
            "  for(const item of Sequence.from(source.xpath('/"|| $property-name || "'))) {",
            "    // let's create and pass the node",
            "    let itemSource = new NodeBuilder();",
            "    itemSource.addNode(fn.head(item));",
            "    // this will return an instance of a " || $ref-name,
            "    " || service:camel-case($property-name) || ".push(" || service:camel-case("extractInstance-" || $ref-name) || "(itemSource.toNode()));",
            "    // or uncomment this to create an external reference to a " || $ref-name,
            "    //" || service:camel-case($property-name) || ".push(makeReferenceObject('" || $ref-name || "', itemSource.toNode()));",
            "  }",
            "}"
          ), "
  ")
        else
          fn:string-join((
            "null;",
            "if(" || $path-to-property || ") {",
            "  // let's create and pass the node",
            "  let " ||$property-name||"Source = new NodeBuilder();",
            "  " ||$property-name||"Source.addNode(fn.head(source.xpath('/"|| $property-name || "'))).toNode();",
            "  // either return an instance of a " || $ref-name,
            "  " || service:camel-case($property-name) || " = " || service:camel-case("extractInstance-" || $ref-name) || "("||$property-name||"Source);",
            "",
            "  // or a reference to a " || $ref-name,
            "  // " || service:camel-case($property-name) || " = makeReferenceObject('" || $ref-name || "', "||$property-name||"Source));",
            "}"
          ), "
  ")
      else
        if ($is-array) then
          fn:string-join((
            " null;",
            "  if (" || service:get-property($path-to-property, $ref-name) || ") {",
            "    " || service:camel-case($property-name) || " = " || service:get-property($path-to-property, $ref-name) || ".map(function(item) {",
            "      return makeReferenceObject('" || $ref-name || "', source.xpath('/"|| $property-name || "'));",
            "    });",
            "  }"
          ), "
")
        else
          " makeReferenceObject('" || $ref-name || "', " || service:get-property($path-to-property, $ref-name) || ")"
    (:          fn:string-join((
            " {",
            "    '$type': '" || $ref-name || "',",
            "    '$ref': " || service:get-property($path-to-property, $ref-name),
            "  }"
          ), "
"):)

    return (
      $property-comment ! ("", .),
      "let " || service:camel-case($property-name) || " = " || $value || ";"
    )
    , "
  ")
(: end code generation block :)
};

declare function service:generate-sjs($entity as xs:string, $flow-type as xs:string, $model as map:map, $mapping as map:map?)
{
  let $root-name :=
    if ($flow-type eq $consts:INPUT_FLOW) then "rawContent"
    else "doc"
  return
    document {<module>'use strict'

/*
* Create Content Plugin
*
* @param id         - the identifier returned by the collector
* @param options    - an object containing options. Options are sent from Java
*
* @return - your content
*/
function createContent(id, {
  if ($flow-type eq $consts:INPUT_FLOW) then
    "rawContent, "
  else ()
}options) {{
  {
    if ($flow-type eq $consts:HARMONIZE_FLOW) then
      "let doc = cts.doc(id);"
    else ()
  }

  let source;

  // for xml we need to use xpath
  if({$root-name} && xdmp.nodeKind({$root-name}) === 'element' && {$root-name} instanceof XMLDocument) {{
    source = {$root-name}
  }}
  // for json we need to return the instance
  else if({$root-name} && {$root-name} instanceof Document) {{
    source = fn.head({$root-name}.root);
  }}
  // for everything else
  else {{
    source = {if ($flow-type eq $consts:INPUT_FLOW) then $root-name else "doc"};
  }}

  return {service:camel-case("extractInstance-" || $entity) || "(source)"};
}}
  {
for $entity-type-name in map:keys(map:get($model, "definitions"))
return <extract-instance>
/**
* Creates an object instance from some source document.
* @param source  A document or node that contains
*   data for populating a {$entity-type-name}
* @return An object with extracted data and
*   metadata about the instance.
*/
function {service:camel-case("extractInstance-" || $entity-type-name)}(source) {{
  {
    if ($entity eq $entity-type-name) then
  "// the original source documents
  let attachments = source;
  // now check to see if we have XML or json, then create a node clone from the root of the instance
  if (source instanceof Element || source instanceof ObjectNode) {
    let instancePath = '/*:envelope/*:instance';
    if(source instanceof Element) {
      instancePath += '/node()';
    }
    source = new NodeBuilder().addNode(fn.head(source.xpath(instancePath))).toNode();
  }
  "
    else (
  "// now check to see if we have XML or json, then create a node clone to operate of off
  if (source instanceof Element || source instanceof ObjectNode) {
    let instancePath = '/';
    if(source instanceof Element) {
      instancePath = '/node()';
    }
    source = new NodeBuilder().addNode(fn.head(source.xpath(instancePath))).toNode();
  }
  "
    )
  }
  {
    if ($entity eq $entity-type-name and fn:empty($mapping) eq fn:false() and fn:empty(map:get($mapping, "name")) eq fn:false()) then
      <txt>/* These mappings were generated using mapping: {map:get($mapping, "name")}, version: {map:get($mapping, "version")} on {fn:current-dateTime()}.*/
  </txt>/text()
    else ()
  }
  {
    service:generate-vars($model, $entity-type-name, $mapping, $entity)
  }

  // return the instance object
  return {{
  {
    if ($entity eq $entity-type-name) then
      "  '$attachments': attachments,"
    else ()
  }
    '$type': '{ $entity-type-name }',
    '$version': '{ map:get(map:get($model, "info"), "version") }'{
  let $definitions := map:get($model, "definitions")
  let $entity-type := map:get($definitions, $entity-type-name)
  let $properties := map:get($entity-type, "properties")
  let $properties-keys := map:keys($properties)
  where fn:count($properties-keys) > 0
  return
    ",
    " ||
    fn:string-join(
      (: Begin code generation block :)
      for $property-name in $properties-keys
      return
        "'" || $property-name || "': " ||  service:camel-case($property-name)
      , ",
    ")
  (: end code generation block :)
  }
  }}
}};
</extract-instance>/text()
}

function makeReferenceObject(type, ref) {{
  return {{
    '$type': type,
    '$ref': ref
  }};
}}

module.exports = {{
  createContent: createContent
}};

</module>/text()
    }
};

declare function service:map-value($key as xs:string, $mapping as map:map?) {
  let $properties := map:get($mapping, "properties")
  let $property := map:get($properties, $key)
  let $source := fn:replace(map:get($mapping, "sourceContext"), "'", '"')
  return fn:concat($source, map:get($property, "sourcedFrom"))
};

declare function service:get-mapping($mapping-name) {
  let $mapping-base-name := functx:substring-before-last($mapping-name, "-")
  let $mapping-uri := fn:concat("/mappings/", $mapping-base-name, "/", $mapping-name, ".mapping.json")
  let $mapping-doc := fn:doc($mapping-uri)
  return
    if(fn:exists($mapping-doc)) then (map:new(xdmp:from-json($mapping-doc)))
    else ()
};

declare function service:mapping-present($mapping as map:map?, $property-name as xs:string?) {
  (fn:empty($mapping) eq fn:false() and fn:empty(map:get(map:get($mapping, "properties"), $property-name)) eq fn:false())
};

declare function service:get(
  $context as map:map,
  $params  as map:map
) as document-node()*
{
  debug:dump-env(),

  perf:log('/v1/resources/validate:get', function() {
    let $entity as xs:string := map:get($params, "entity")
    let $code-format as xs:string := map:get($params, "codeFormat")
    let $flow-type as xs:string := map:get($params, "flowType")
    let $mapping-name as xs:string? := map:get($params, "mapping")
    let $mapping as map:map? := if(fn:empty($mapping-name) eq fn:false()) then (service:get-mapping($mapping-name)) else ()
    let $model as map:map? := hent:get-model($entity)
    return
      if (fn:exists($model)) then
        if((fn:empty($mapping) eq fn:false() and fn:empty($mapping-name) eq fn:false()) or (fn:empty($mapping-name) eq fn:true())) then
          if ($code-format eq "xqy") then
            service:generate-xqy($entity, $flow-type, $model, $mapping)
          else
            service:generate-sjs($entity, $flow-type, $model, $mapping)
        else
          fn:error((),"RESTAPI-SRVEXERR", (404, "Not Found", "The requested mapping: " || $mapping-name || " was not found"))
      else
        fn:error((),"RESTAPI-SRVEXERR", (404, "Not Found", "The requested entity: " || $entity || " was not found"))
  })
};

(:
  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 service = "http://marklogic.com/rest-api/extensions/scaffold-content";

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

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

import module namespace functx = "http://www.functx.com"
at "/MarkLogic/functx/functx-1.0-nodoc-2007-01.xqy";

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

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

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

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

declare namespace rapi = "http://marklogic.com/rest-api";

declare option xdmp:mapping "false";

declare function service:comment-xqy($comment-text as xs:string*)
{
  "(: " || fn:string-join($comment-text, "
     ") || " :)"
};

declare function service:comment-sjs($comment-text as xs:string*)
{
  "/* " || fn:string-join($comment-text, "
     ") || " */"
};

declare function service:kebob-case($str as xs:string)
{
  fn:lower-case(fn:replace(fn:replace($str, "([A-Z])", "-$1"), "^-", ""))
};

declare function service:camel-case($str as xs:string)
{
  fn:string-join(
    let $tokens := fn:tokenize($str, "[-_]")
    return
      (
        $tokens[1],
        for $x in fn:subsequence($tokens, 2)
        return
          functx:capitalize-first($x)
      ),
    "")
};

declare function service:get-property($root as xs:string, $property as xs:string)
{
  if (fn:contains($property, "-")) then
    $root || "['" || $property || "']"
  else
    $root || "." || $property
};

declare function service:casting-function-name-xqy(
  $datatype as xs:string
) as xs:string
{
  if ($datatype eq "iri")
  then "sem:iri"
  else "xs:" || $datatype
};

declare function service:casting-function-name-sjs(
  $datatype as xs:string
) as xs:string
{
  if ($datatype eq "iri")
  then "sem.iri"
  else "xs." || $datatype
};

declare function service:generate-lets($model as map:map, $entity-type-name, $mapping as map:map?, $parent-entity as xs:string)
{
  fn:string-join(
    let $definitions := map:get($model, "definitions")
    let $entity-type := map:get($definitions, $entity-type-name)
    let $properties := map:get($entity-type, "properties")
    let $required-properties := (
      map:get($entity-type, "primaryKey"),
      map:get($entity-type, "required") ! json:array-values(.)
    )
    for $property-name in map:keys($properties)
    let $is-required := $property-name = $required-properties
    let $property := map:get($properties, $property-name)
    let $is-array := map:get($property, "datatype") eq "array"
    let $property := map:get($properties, $property-name)
    let $property-datatype := esi:resolve-datatype($model, $entity-type-name, $property-name)
    let $casting-function-name :=
      if (map:contains($property, "datatype") and map:get($property, "datatype") ne "array") then
        service:casting-function-name-xqy($property-datatype)
      else ()
    let $wrap-if-array := function($str) {
      if ($is-array) then
        "json:to-array(" || $str || ")"
      else
        $str
    }
    let $ref :=
      if ($is-array) then
        let $items as map:map? := map:get($property, "items")
        return
          $items ! map:get(., "$ref")
      else
        map:get($property, "$ref")
    let $path-to-property := fn:concat("$source-node/", $property-name)
    let $property-comment :=
      if (fn:empty($ref)) then ()
      else if (fn:contains($ref, "#/definitions")) then
        service:comment-xqy("The following property is a local reference.")
      else (
          service:comment-xqy((
            'The following property assigment comes from an external reference.',
            'Its generated value probably requires developer attention.'
          ))
        )
    let $ref-name := functx:substring-after-last($ref, "/")
    let $extract-reference-fn :=
      fn:string-join((
        "",
        "    plugin:make-reference-object('" || $ref-name || "', (: put your value here :) '')"
      ), "
")
    let $value :=
      if (empty($ref)) then (
        if(service:mapping-present($mapping, $property-name) and $parent-entity eq $entity-type-name)
        then (fn:concat("$source",service:map-value($property-name, $mapping)))
        else ($wrap-if-array(fn:concat("$source/", $property-name))))
      else if (contains($ref, "#/definitions")) then
        let $inner-var := "$" || fn:lower-case($ref-name) || "s"
        let $inner-val :=
          if(service:mapping-present($mapping, $property-name))
          then (fn:concat("$source",service:map-value($property-name, $mapping)))
          else (fn:concat("$source/", $property-name))
        return
          fn:string-join((
            "",
            "let " || $inner-var || " :=",
            "  (: create a sequence of " || $ref-name || " instances from your data :)",
            "  for $sub-entity in ("||$inner-val||")",
            "  return",
            "    plugin:extract-instance-" || $ref-name || "($sub-entity)",
            "return",
            if ($is-required) then
              "  json:to-array(" || $inner-var || ")"
            else (
              "  if (fn:exists(" || $inner-var || ")) then",
              "    json:to-array(" || $inner-var || ")",
              "  else ()"
            )
          ), "
    ") || "
"
      else if(fn:not(empty($ref))) then
           fn:concat("$source/", $property-name)
      else $wrap-if-array($extract-reference-fn)

    return (
      $property-comment ! ("", .),

      let $name := service:kebob-case($property-name)
      let $valueWrap := fn:concat(fn:string-join(
        if ($casting-function-name) then
          $casting-function-name else ())
        , fn:concat(
          "(", $value,")"))
      return
        "let $" || $name || " := " || $valueWrap
    )
    , "
  ")
(: end code generation block :)
};

declare function service:generate-xqy($entity as xs:string, $flow-type as xs:string, $model as map:map, $mapping as map:map?)
{
  let $root-name :=
    if ($flow-type eq $consts:INPUT_FLOW) then "$raw-content"
    else "$doc"
  return
    document {
<module>xquery version "1.0-ml";

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

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

declare option xdmp:mapping "false";

(:~
: Create Content Plugin
:
: @param $id          - the identifier returned by the collector
: @param $options     - a map containing options. Options are sent from Java
:
: @return - your transformed content
:)
declare function plugin:create-content(
  $id as xs:string,
  {
    if ($flow-type eq $consts:INPUT_FLOW) then
      "$raw-content as node()?,
  "
    else ()
  }$options as map:map) as map:map
{{
  {
    if ($flow-type eq $consts:HARMONIZE_FLOW) then
      "let $doc := fn:doc($id)
  "
    else ()
  }let $source := {$root-name}
  return
  {
    "plugin:extract-instance-" || $entity || "($source)"
  }
}};
  {
for $entity-type-name in map:keys(map:get($model, "definitions"))
return
<extract-instance>
(:~
: Creates a map:map instance from some source document.
: @param $source-node  A document or node that contains
:   data for populating a {$entity-type-name}
: @return A map:map instance with extracted data and
:   metadata about the instance.
:)
declare function plugin:extract-instance-{$entity-type-name}(
$source as node()?
) as map:map
{{
{
  if ($entity-type-name eq $entity) then
  <txt>
  (: the original source documents :)
  let $attachments := $source
  let $source      :=
    if ($source/*:envelope and $source/node() instance of element()) then
      $source/*:envelope/*:instance/node()
    else if ($source/*:envelope) then
      $source/*:envelope/*:instance
    else if ($source/instance) then
      $source/instance
    else
      $source
  </txt>/text()
  else (<txt>
  let $source :=
    if($source/node() instance of element()) then
    $source/node()
  else (
    $source
  )
  </txt>/text()
  )
}
{
  if ($entity eq $entity-type-name and fn:empty($mapping) eq fn:false() and fn:empty(map:get($mapping, "name")) eq fn:false()) then
  <txt>(: These mappings were generated using mapping: {map:get($mapping, "name")}, version: {map:get($mapping, "version")} on {fn:current-dateTime()}. :)
  </txt>/text()
  else ()
}
{
service:generate-lets($model, $entity-type-name, $mapping, $entity)
}

  (: return the in-memory instance :)
  (: using the XQuery 3.0 syntax... :)
  let $model := json:object()
  let $_ := (
  {
    if ($entity-type-name eq $entity) then
      "  map:put($model, '$attachments', $attachments),"
    else ()
  }
    map:put($model, '$type', '{ $entity-type-name }'),
    map:put($model, '$version', '{ map:get(map:get($model, "info"), "version") }'){
  let $definitions := map:get($model, "definitions")
  let $entity-type := map:get($definitions, $entity-type-name)
  let $properties := map:get($entity-type, "properties")
  let $property-keys := map:keys($properties)
  where fn:count($property-keys) > 0
  return
    ",
" ||
    fn:string-join(
      (: Begin code generation block :)
      let $required-properties := (
        map:get($entity-type, "primaryKey"),
        map:get($entity-type, "required") ! json:array-values(.)
      )
      for $property-name in $property-keys
      let $is-required := $property-name = $required-properties
      return
        "    map:put($model, '" || $property-name || "', $" || service:kebob-case($property-name) || ")"
      , ",
")
  (: end code generation block :)
  }
  )

  (: if you prefer the xquery 3.1 version with the => operator....
  https://www.w3.org/TR/xquery-31/#id-arrow-operator
  let $model :=
  json:object()
  {
  if ($entity-type-name eq $entity) then
    "  =>map:with('$attachments', $attachments)"
  else ()
  }
    =>map:with('$type', '{ $entity-type-name }')
    =>map:with('$version', '{ map:get(map:get($model, "info"), "version") }')
  {
  fn:string-join(
    (: Begin code generation block :)
    let $definitions := map:get($model, "definitions")
    let $entity-type := map:get($definitions, $entity-type-name)
    let $properties := map:get($entity-type, "properties")
    let $required-properties := (
      map:get($entity-type, "primaryKey"),
      json:array-values(map:get($entity-type, "required"))
    )
    for $property-name in map:keys($properties)
    let $is-required := $property-name = $required-properties
    return
      if ($is-required) then
        "  =>map:with('" || $property-name || "', $" || service:kebob-case($property-name) || ")"
      else
        "    =>es:optional('" || $property-name || "', $" || service:kebob-case($property-name) || ")"
    , "
")
  (: end code generation block :)
  }
  :)
  return $model
}};
</extract-instance>/text()
  }
declare function plugin:make-reference-object(
$type as xs:string,
$ref as xs:string)
{{
  let $o := json:object()
  let $_ := (
    map:put($o, '$type', $type),
    map:put($o, '$ref', $ref)
  )
  return
  $o
}};</module>/text()
}
};

declare function service:generate-vars($model as map:map, $entity-type-name, $mapping as map:map?, $parent-entity as xs:string)
{
  fn:string-join(
    let $definitions := map:get($model, "definitions")
    let $entity-type := map:get($definitions, $entity-type-name)
    let $properties := map:get($entity-type, "properties")
    let $required-properties := (
      map:get($entity-type, "primaryKey"),
      map:get($entity-type, "required") ! json:array-values(.)
    )
    for $property-name in map:keys($properties)
    let $is-required := $property-name = $required-properties

    let $property := map:get($properties, $property-name)
    let $is-array := map:get($property, "datatype") eq "array"
    let $property-datatype := esi:resolve-datatype($model, $entity-type-name, $property-name)
    let $casting-function-name := service:casting-function-name-sjs($property-datatype)
    let $wrap-if-array := function($str) {
      if ($is-array) then
        "json:to-array(" || $str || ")"
      else
        $str
    }
    let $ref :=
      if ($is-array) then
        let $items as map:map? := map:get($property, "items")
        return
          $items ! map:get(., "$ref")
      else
        map:get($property, "$ref")
    let $path-to-property :=
      if (service:mapping-present($mapping, $property-name) and $parent-entity eq $entity-type-name) then (fn:concat("source.xpath('",service:map-value($property-name, $mapping), "')"))  else (fn:concat("source.xpath('/", $property-name, "')"))
    let $property-comment :=
      if (fn:empty($ref)) then ()
      else if (fn:contains($ref, "#/definitions")) then
        service:comment-sjs("The following property is a local reference.")
      else (
          service:comment-sjs((
            'The following property assigment comes from an external reference.',
            'Its generated value probably requires developer attention.'
          ))
        )
    let $ref-name := functx:substring-after-last($ref, "/")
    (:    let $extract-reference-fn :=
      fn:string-join((
        " {",
        "    '$type': '" || $ref-name || "',",
        "    '$ref': " || service:get-property($path-to-property, $ref-name),
        "  }"
      ), "
"):)
    let $value :=
      if (empty($ref)) then
        "!fn.empty(" || $path-to-property || ") ? " || (
        if($is-array) then
          $path-to-property || " : []"
        else
        $casting-function-name || "("
        || "fn.head(" ||
        $path-to-property ||
        (
          if ($property-datatype eq "iri") then
            ".toString()"
          else
            ()
        ) ||
        ")) : null"
        )
      else if (contains($ref, "#/definitions")) then
        if ($is-array) then
          fn:string-join((
            "[];",
            "if(" || $path-to-property || ") {",
            "  for(const item of Sequence.from(source.xpath('/"|| $property-name || "'))) {",
            "    // let's create and pass the node",
            "    let itemSource = new NodeBuilder();",
            "    itemSource.addNode(fn.head(item));",
            "    // this will return an instance of a " || $ref-name,
            "    " || service:camel-case($property-name) || ".push(" || service:camel-case("extractInstance-" || $ref-name) || "(itemSource.toNode()));",
            "    // or uncomment this to create an external reference to a " || $ref-name,
            "    //" || service:camel-case($property-name) || ".push(makeReferenceObject('" || $ref-name || "', itemSource.toNode()));",
            "  }",
            "}"
          ), "
  ")
        else
          fn:string-join((
            "null;",
            "if(" || $path-to-property || ") {",
            "  // let's create and pass the node",
            "  let " ||$property-name||"Source = new NodeBuilder();",
            "  " ||$property-name||"Source.addNode(fn.head(source.xpath('/"|| $property-name || "'))).toNode();",
            "  // either return an instance of a " || $ref-name,
            "  " || service:camel-case($property-name) || " = " || service:camel-case("extractInstance-" || $ref-name) || "("||$property-name||"Source);",
            "",
            "  // or a reference to a " || $ref-name,
            "  // " || service:camel-case($property-name) || " = makeReferenceObject('" || $ref-name || "', "||$property-name||"Source));",
            "}"
          ), "
  ")
      else
        if ($is-array) then
          fn:string-join((
            " null;",
            "  if (" || service:get-property($path-to-property, $ref-name) || ") {",
            "    " || service:camel-case($property-name) || " = " || service:get-property($path-to-property, $ref-name) || ".map(function(item) {",
            "      return makeReferenceObject('" || $ref-name || "', source.xpath('/"|| $property-name || "'));",
            "    });",
            "  }"
          ), "
")
        else
          " makeReferenceObject('" || $ref-name || "', " || service:get-property($path-to-property, $ref-name) || ")"
    (:          fn:string-join((
            " {",
            "    '$type': '" || $ref-name || "',",
            "    '$ref': " || service:get-property($path-to-property, $ref-name),
            "  }"
          ), "
"):)

    return (
      $property-comment ! ("", .),
      "let " || service:camel-case($property-name) || " = " || $value || ";"
    )
    , "
  ")
(: end code generation block :)
};

declare function service:generate-sjs($entity as xs:string, $flow-type as xs:string, $model as map:map, $mapping as map:map?)
{
  let $root-name :=
    if ($flow-type eq $consts:INPUT_FLOW) then "rawContent"
    else "doc"
  return
    document {<module>'use strict'

/*
* Create Content Plugin
*
* @param id         - the identifier returned by the collector
* @param options    - an object containing options. Options are sent from Java
*
* @return - your content
*/
function createContent(id, {
  if ($flow-type eq $consts:INPUT_FLOW) then
    "rawContent, "
  else ()
}options) {{
  {
    if ($flow-type eq $consts:HARMONIZE_FLOW) then
      "let doc = cts.doc(id);"
    else ()
  }

  let source;

  // for xml we need to use xpath
  if({$root-name} && xdmp.nodeKind({$root-name}) === 'element' && {$root-name} instanceof XMLDocument) {{
    source = {$root-name}
  }}
  // for json we need to return the instance
  else if({$root-name} && {$root-name} instanceof Document) {{
    source = fn.head({$root-name}.root);
  }}
  // for everything else
  else {{
    source = {if ($flow-type eq $consts:INPUT_FLOW) then $root-name else "doc"};
  }}

  return {service:camel-case("extractInstance-" || $entity) || "(source)"};
}}
  {
for $entity-type-name in map:keys(map:get($model, "definitions"))
return <extract-instance>
/**
* Creates an object instance from some source document.
* @param source  A document or node that contains
*   data for populating a {$entity-type-name}
* @return An object with extracted data and
*   metadata about the instance.
*/
function {service:camel-case("extractInstance-" || $entity-type-name)}(source) {{
  {
    if ($entity eq $entity-type-name) then
  "// the original source documents
  let attachments = source;
  // now check to see if we have XML or json, then create a node clone from the root of the instance
  if (source instanceof Element || source instanceof ObjectNode) {
    let instancePath = '/*:envelope/*:instance';
    if(source instanceof Element) {
      instancePath += '/node()';
    }
    source = new NodeBuilder().addNode(fn.head(source.xpath(instancePath))).toNode();
  }
  "
    else (
  "// now check to see if we have XML or json, then create a node clone to operate of off
  if (source instanceof Element || source instanceof ObjectNode) {
    let instancePath = '/';
    if(source instanceof Element) {
      instancePath = '/node()';
    }
    source = new NodeBuilder().addNode(fn.head(source.xpath(instancePath))).toNode();
  }
  "
    )
  }
  {
    if ($entity eq $entity-type-name and fn:empty($mapping) eq fn:false() and fn:empty(map:get($mapping, "name")) eq fn:false()) then
      <txt>/* These mappings were generated using mapping: {map:get($mapping, "name")}, version: {map:get($mapping, "version")} on {fn:current-dateTime()}.*/
  </txt>/text()
    else ()
  }
  {
    service:generate-vars($model, $entity-type-name, $mapping, $entity)
  }

  // return the instance object
  return {{
  {
    if ($entity eq $entity-type-name) then
      "  '$attachments': attachments,"
    else ()
  }
    '$type': '{ $entity-type-name }',
    '$version': '{ map:get(map:get($model, "info"), "version") }'{
  let $definitions := map:get($model, "definitions")
  let $entity-type := map:get($definitions, $entity-type-name)
  let $properties := map:get($entity-type, "properties")
  let $properties-keys := map:keys($properties)
  where fn:count($properties-keys) > 0
  return
    ",
    " ||
    fn:string-join(
      (: Begin code generation block :)
      for $property-name in $properties-keys
      return
        "'" || $property-name || "': " ||  service:camel-case($property-name)
      , ",
    ")
  (: end code generation block :)
  }
  }}
}};
</extract-instance>/text()
}

function makeReferenceObject(type, ref) {{
  return {{
    '$type': type,
    '$ref': ref
  }};
}}

module.exports = {{
  createContent: createContent
}};

</module>/text()
    }
};

declare function service:map-value($key as xs:string, $mapping as map:map?) {
  let $properties := map:get($mapping, "properties")
  let $property := map:get($properties, $key)
  let $source := map:get($mapping, "sourceContext")
  return fn:concat($source, map:get($property, "sourcedFrom"))
};

declare function service:get-mapping($mapping-name) {
  let $mapping-base-name := functx:substring-before-last($mapping-name, "-")
  let $mapping-uri := fn:concat("/mappings/", $mapping-base-name, "/", $mapping-name, ".mapping.json")
  let $mapping-doc := fn:doc($mapping-uri)
  return
    if(fn:exists($mapping-doc)) then (map:new(xdmp:from-json($mapping-doc)))
    else ()
};

declare function service:mapping-present($mapping as map:map?, $property-name as xs:string?) {
  (fn:empty($mapping) eq fn:false() and fn:empty(map:get(map:get($mapping, "properties"), $property-name)) eq fn:false())
};

declare function service:get(
  $context as map:map,
  $params  as map:map
) as document-node()*
{
  debug:dump-env(),

  perf:log('/v1/resources/validate:get', function() {
    let $entity as xs:string := map:get($params, "entity")
    let $code-format as xs:string := map:get($params, "codeFormat")
    let $flow-type as xs:string := map:get($params, "flowType")
    let $mapping-name as xs:string? := map:get($params, "mapping")
    let $mapping as map:map? := if(fn:empty($mapping-name) eq fn:false()) then (service:get-mapping($mapping-name)) else ()
    let $model as map:map? := hent:get-model($entity)
    return
      if (fn:exists($model)) then
        if((fn:empty($mapping) eq fn:false() and fn:empty($mapping-name) eq fn:false()) or (fn:empty($mapping-name) eq fn:true())) then
          if ($code-format eq "xqy") then
            service:generate-xqy($entity, $flow-type, $model, $mapping)
          else
            service:generate-sjs($entity, $flow-type, $model, $mapping)
        else
          fn:error((),"RESTAPI-SRVEXERR", (404, "Not Found", "The requested mapping: " || $mapping-name || " was not found"))
      else
        fn:error((),"RESTAPI-SRVEXERR", (404, "Not Found", "The requested entity: " || $entity || " was not found"))
  })
};


excepted 3 test cases that cause segfaults

(:
 : Copyright 2006-2011 The FLWOR Foundation.
 :
 : 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.
 :)

(:~
 : Zorba FOTS driver CLI
 : @author Ghislain Fourny, Sorin Nasoi
 :)

import module namespace d =
  "http://www.zorba-xquery.com/fots-driver" at "fots-driver.xq";

import module namespace r =
  "http://www.zorba-xquery.com/fots-driver/reporting" at "reporting.xq";

declare namespace op = "http://www.zorba-xquery.com/options/features";
declare namespace f = "http://www.zorba-xquery.com/features";
declare option op:disable "f:trace";

(:~
 : Path to the FOTS catalog.xml file. If the path is relative, it will be
 : resolved relative to the directory containing this cli.xq file.
 : By default it is assumed that the FOTS was imported using CMake (i.e. after
 : 'make fots-import' and 'make fots-activate-sets' were run).
 :)
declare variable $fotsPath as xs:string external :=
  "../../build/test/fots/2011/QT3-test-suite/catalog.xml";

(:~
 : Path to the FOTSZorbaManifest.xml file. If the path is relative, it will be
 : resolved relative to the diractory containing this cli.xq file
 :)
declare variable $fotsZorbaManifestPath as xs:string external :=
  "FOTSZorbaManifest.xml";

(:~
 : Path to the results XML file generated by a previous run. Used when we just
 : want to generate a report based on some previous run, i.e., without running
 : the tests again.
 :)
declare variable $resultsFilePath as xs:string external := "";

(:~
 : Path to the ExpectedFailures file.
 :)
declare variable $expectedFailuresPath as xs:string external :="";

(:~
 : The CLI command you want to run.
 :)
declare variable $mode as xs:string external := "";

(:~
 : A list of comma-seperated prefixes that acts as a filter for the test-sets
 : to be processed: a test-set is going to be proccesed only if its name starts
 : with a prefix in this list. An empty string means no filtering.
 :
 : Used by the list-test-sets, list-test-cases, and run-test-sets commands.
 :)
declare variable $testSetPrefixes as xs:string external := "";

(:~
 : A list of comma-seperated prefixes that acts as a filter for the test-cases
 : to be processed: a test-case is going to be proccesed only if its name starts
 : with a prefix in this list. An empty string means no filtering.
 :
 : Used by the list-test-cases, and run-test-sets commands.
 :)
declare variable $testCasePrefixes as xs:string external := "";

(:~
 : The test cases in this list should not have their queries evaluated at all
 : (because they segfault, or hang, or take too long, etc).
 :
 : Used by the run-test-sets, run-and-report, and report commands.
 :)
declare variable $exceptedTestCases as xs:string* := (
  "fn-function-lookup-428",
  "fn-function-lookup-430",
  "fn-function-lookup-432",
  "fn-unparsed-text-lines-052",
  "cbcl-subsequence-011",
  "cbcl-subsequence-012",
  "cbcl-subsequence-013",
  "cbcl-subsequence-014"        (:see bug lp:1069794 :)
, "re00975",
  "re00976",
  "re00976a"                    (:see bug lp:1070533 :)
);

(:~
 : The test sets in this list should not be not be processed at all.
 :
 : Used by the run-test-sets, run-and-report, and report commands.
 :)
declare variable $exceptedTestSets as xs:string* := ();

(:~
 : Name of the test-set containing a test-case to process. Used only for the
 : "run-test-case" command.
 :)
declare variable $testSetName as xs:string external := "";

(:~
 : Name of the test-case to process. Used only for the "run-test-case" command.
 :)
declare variable $testCaseName as xs:string external := "";

(:~
 : A dependency used in the 'list-test-cases' and 'run-test-sets' commands to
 : filter the test-cases that will actually be listed/run. Only test-cases whose
 : applicable dependencies contain at least one dependency the matches this
 : user-specified dependency will be listed/run. The filtering dependency is
 : given as a string of the form "depValue_depSatisfied" (for example,
 : "XQ30+_true"), or just "depValue" (in which case "true" is assumed as the
 : value of the satisfied attribute). If $dependency is set to the empty string,
 : no filtering is done.
 :
 : Used in the list-test-cases and run-test-sets commands.
 :)
declare variable $dependency as xs:string external := "";

(:~
 : List of assertion types used in the 'list-test-cases' and 'run-test-sets'
 : commands to filter the test-cases that will actually be listed/run. A test
 : case qualifies if there is at least one element node under the <result>
 : node of the <test-case> whose local name is equal to one of the strings
 : in the filtering set. If $assrtType is set to the empty sequence, no
 : filtering is done.
 :
 : Used in the list-test-cases and run-test-sets commands.
 :)
declare variable $assertions as xs:string* external := ();

(:~
 : Regex to be used by the 'list-matching-test-cases' command.
 :)
declare variable $pattern as xs:string external := "";

(:~
 : Flags to be used by the 'list-matching-test-cases' command.
 :)
declare variable $flags as xs:string external := "";

(:~
 : Enable or disable verbose output. When this is set to true the exact query
 : that is run by XQXQ is also written down into a query_*.xq file.
 :)
declare variable $verbose as xs:string external := "false";

declare function local:usage() as xs:string
{
  string-join((
    "Zorba FOTS driver usage examples:",
    "If you run Zorba from a checkout of the trunk and the build/bin folder,",
    "- /path/to/cli.xq can be set to ../../test/fots_driver/cli.xq",
    "",
    "Always try to output the result back to an XML file with nice indentation:",
    "./zorba -f -q ../../test/fots_driver/cli.xq -e SET_CLI_OPTIONS_HERE -o output.xml --indent",
    "",
    " This way you will see trace information in the CLI window and detailed",
    " results of the test cases in the 'output.xml'.",
    "",
    " Please note that when Verbose is set to true the query that is executed",
  	" is written down into a query_TESTCASENAME.xq file, where TESTCASENAME is",
  	" the test case name.",
  	"",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e fotsZorbaManifestPath:=/path/to/Zorba_manifest.xml -e mode:=list-test-sets",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-sets",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-sets -e testSetPrefixes:=prod,app",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-cases -e testSetPrefixes:=prod-Literal",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-cases -e dependency:=higherOrderFunctions",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-cases -e dependency:=higherOrderFunctions -e assertions:=assert-count",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-matching-test-cases -e pattern:=catch",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -e expectedFailuresPath:=ExpectedFailures.xml -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -e dependency:=higherOrderFunctions_false -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -e assertions:=assert-count -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod-Literal -e verbose:=true -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-set  -e testSetName:=fn-matches -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-case -e testSetName:=prod-Literal -e testCaseName:=Literals001 -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-and-report -o results_Zorba_XQ30.xml --indent --disable-http-resolution",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=report -e resultsFilePath:=results.xml -o results_Zorba_XQ30.xml --indent",
    "zorba -f -q /path/to/cli.xq -e mode:=generate-expected-failures -e resultsFilePath:=failures.xml -o ExpectedFailures.xml --indent",
    ""
    ), "
")
};

(:~
 : Tokenize a string that contains a comma-separated list of tokens.
 : Note: if the input string is empty, the function returns the empty sequence.
 :)
declare %private function local:tokenize(
  $input as xs:string
) as xs:string*
{
  tokenize($input, ",")
};

variable $fotsPathMsg := "The path to FOTS catalog.xml was set to: ";

variable $testSetPrefixesMsg := "'testSetPrefixes' was set to: ";

variable $testSetNameMsg := "'testSetName' was set to: ";

variable $testCasePrefixesMsg := "'testCasePrefixes' was set to: ";

variable $testCaseNameMsg := "'testCaseName' was set to: ";

switch ($mode)

case "list-test-sets"
return
{
  trace($fotsPath, $fotsPathMsg);
  trace($testSetPrefixes, $testSetPrefixesMsg);

  string-join
  (
  (
    d:list-test-sets($fotsPath, local:tokenize($testSetPrefixes))
  ),
  "
"
  )
}

case "list-test-cases"
return
{
  trace($fotsPath, $fotsPathMsg);
  trace($testSetPrefixes, $testSetPrefixesMsg);
  trace($dependency, "'dependency' set to:");
  trace($assertions, "'assertions' set to: ");

  string-join
  (
  (
    d:list-test-cases($fotsPath,
                      d:list-test-sets($fotsPath, local:tokenize($testSetPrefixes)),
                      $dependency,
                      $assertions)
  ),
  "
"
  )
}

case "list-matching-test-cases"
return
{
  trace($fotsPath, $fotsPathMsg);
  trace($pattern, "pattern set to: ");
  trace($flags, "flags were set to: ");

  string-join
  (
  (
    d:list-matching-test-cases($fotsPath, $pattern, $flags), ""
  ),
  "
"
  )
}

case "run-test-sets"
return
{
  trace($testSetPrefixes, $testSetPrefixesMsg);
  trace($testCasePrefixes, $testCasePrefixesMsg);
  trace($dependency, "'dependency' set to:");
  trace($assertions, "'assertions' set to: ");
  trace($verbose, "'verbose' set to:");
  trace($mode, "Cli command was set to:");

  d:run-fots($fotsPath,
             $fotsZorbaManifestPath,
             local:tokenize($testSetPrefixes),
             $exceptedTestSets,
             local:tokenize($testCasePrefixes),
             $exceptedTestCases,
             $dependency,
             $assertions,
             xs:boolean($verbose),
             $expectedFailuresPath,
             $mode)
}

case "run-test-set"
return
{
  trace($testSetName, $testSetNameMsg);
  trace($dependency, "'dependency' set to:");
  trace($assertions, "'assertions' set to: ");
  trace($verbose, "'verbose' set to:");
  trace($mode, "Cli command was set to:");

  d:run-test-set($fotsPath,
                 $fotsZorbaManifestPath,
                 $testSetName,
                 $exceptedTestSets,
                 (),
                 $exceptedTestCases,
                 $dependency,
                 $assertions,
                 xs:boolean($verbose),
                 $expectedFailuresPath,
                 $mode)
}

case "run-test-case"
return
{
  trace($testSetName, $testSetNameMsg);
  trace($testCaseName, $testCaseNameMsg);
  trace($verbose, "'verbose' set to:");
  trace($mode, "Cli command was set to:");

  d:run-fots($fotsPath,
             $fotsZorbaManifestPath,
             $testSetName,
             $exceptedTestSets,
             $testCaseName,
             $exceptedTestCases,
             "",
             (),
             xs:boolean($verbose),
             $expectedFailuresPath,
             $mode)
}

case "run-and-report"
return
{
  r:run-and-report($fotsPath,
                   $fotsZorbaManifestPath,
                   $exceptedTestCases,
                   $exceptedTestSets)
}

case "report"
return
{
  r:report($fotsZorbaManifestPath,
           $resultsFilePath)
}

case "generate-expected-failures"
return
{
  r:generate-expected-failures($resultsFilePath)
}

default
return
  local:usage()

(:
 : Copyright 2006-2011 The FLWOR Foundation.
 :
 : 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.
 :)

(:~
 : Zorba FOTS driver CLI
 : @author Ghislain Fourny, Sorin Nasoi
 :)

import module namespace d =
  "http://www.zorba-xquery.com/fots-driver" at "fots-driver.xq";

import module namespace r =
  "http://www.zorba-xquery.com/fots-driver/reporting" at "reporting.xq";

declare namespace op = "http://www.zorba-xquery.com/options/features";
declare namespace f = "http://www.zorba-xquery.com/features";
declare option op:disable "f:trace";

(:~
 : Path to the FOTS catalog.xml file. If the path is relative, it will be
 : resolved relative to the directory containing this cli.xq file.
 : By default it is assumed that the FOTS was imported using CMake (i.e. after
 : 'make fots-import' and 'make fots-activate-sets' were run).
 :)
declare variable $fotsPath as xs:string external :=
  "../../build/test/fots/2011/QT3-test-suite/catalog.xml";

(:~
 : Path to the FOTSZorbaManifest.xml file. If the path is relative, it will be
 : resolved relative to the diractory containing this cli.xq file
 :)
declare variable $fotsZorbaManifestPath as xs:string external :=
  "FOTSZorbaManifest.xml";

(:~
 : Path to the results XML file generated by a previous run. Used when we just
 : want to generate a report based on some previous run, i.e., without running
 : the tests again.
 :)
declare variable $resultsFilePath as xs:string external := "";

(:~
 : Path to the ExpectedFailures file.
 :)
declare variable $expectedFailuresPath as xs:string external :="";

(:~
 : The CLI command you want to run.
 :)
declare variable $mode as xs:string external := "";

(:~
 : A list of comma-seperated prefixes that acts as a filter for the test-sets
 : to be processed: a test-set is going to be proccesed only if its name starts
 : with a prefix in this list. An empty string means no filtering.
 :
 : Used by the list-test-sets, list-test-cases, and run-test-sets commands.
 :)
declare variable $testSetPrefixes as xs:string external := "";

(:~
 : A list of comma-seperated prefixes that acts as a filter for the test-cases
 : to be processed: a test-case is going to be proccesed only if its name starts
 : with a prefix in this list. An empty string means no filtering.
 :
 : Used by the list-test-cases, and run-test-sets commands.
 :)
declare variable $testCasePrefixes as xs:string external := "";

(:~
 : The test cases in this list should not have their queries evaluated at all
 : (because they segfault, or hang, or take too long, etc).
 :
 : Used by the run-test-sets, run-and-report, and report commands.
 :)
declare variable $exceptedTestCases as xs:string* := (
  "fn-unparsed-text-lines-052",
  "cbcl-subsequence-011",
  "cbcl-subsequence-012",
  "cbcl-subsequence-013",
  "cbcl-subsequence-014"        (:see bug lp:1069794 :)
, "re00975",
  "re00976",
  "re00976a"                    (:see bug lp:1070533 :)
);

(:~
 : The test sets in this list should not be not be processed at all.
 :
 : Used by the run-test-sets, run-and-report, and report commands.
 :)
declare variable $exceptedTestSets as xs:string* := ();

(:~
 : Name of the test-set containing a test-case to process. Used only for the
 : "run-test-case" command.
 :)
declare variable $testSetName as xs:string external := "";

(:~
 : Name of the test-case to process. Used only for the "run-test-case" command.
 :)
declare variable $testCaseName as xs:string external := "";

(:~
 : A dependency used in the 'list-test-cases' and 'run-test-sets' commands to
 : filter the test-cases that will actually be listed/run. Only test-cases whose
 : applicable dependencies contain at least one dependency the matches this
 : user-specified dependency will be listed/run. The filtering dependency is
 : given as a string of the form "depValue_depSatisfied" (for example,
 : "XQ30+_true"), or just "depValue" (in which case "true" is assumed as the
 : value of the satisfied attribute). If $dependency is set to the empty string,
 : no filtering is done.
 :
 : Used in the list-test-cases and run-test-sets commands.
 :)
declare variable $dependency as xs:string external := "";

(:~
 : List of assertion types used in the 'list-test-cases' and 'run-test-sets'
 : commands to filter the test-cases that will actually be listed/run. A test
 : case qualifies if there is at least one element node under the <result>
 : node of the <test-case> whose local name is equal to one of the strings
 : in the filtering set. If $assrtType is set to the empty sequence, no
 : filtering is done.
 :
 : Used in the list-test-cases and run-test-sets commands.
 :)
declare variable $assertions as xs:string* external := ();

(:~
 : Regex to be used by the 'list-matching-test-cases' command.
 :)
declare variable $pattern as xs:string external := "";

(:~
 : Flags to be used by the 'list-matching-test-cases' command.
 :)
declare variable $flags as xs:string external := "";

(:~
 : Enable or disable verbose output. When this is set to true the exact query
 : that is run by XQXQ is also written down into a query_*.xq file.
 :)
declare variable $verbose as xs:string external := "false";

declare function local:usage() as xs:string
{
  string-join((
    "Zorba FOTS driver usage examples:",
    "If you run Zorba from a checkout of the trunk and the build/bin folder,",
    "- /path/to/cli.xq can be set to ../../test/fots_driver/cli.xq",
    "",
    "Always try to output the result back to an XML file with nice indentation:",
    "./zorba -f -q ../../test/fots_driver/cli.xq -e SET_CLI_OPTIONS_HERE -o output.xml --indent",
    "",
    " This way you will see trace information in the CLI window and detailed",
    " results of the test cases in the 'output.xml'.",
    "",
    " Please note that when Verbose is set to true the query that is executed",
  	" is written down into a query_TESTCASENAME.xq file, where TESTCASENAME is",
  	" the test case name.",
  	"",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e fotsZorbaManifestPath:=/path/to/Zorba_manifest.xml -e mode:=list-test-sets",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-sets",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-sets -e testSetPrefixes:=prod,app",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-cases -e testSetPrefixes:=prod-Literal",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-cases -e dependency:=higherOrderFunctions",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-cases -e dependency:=higherOrderFunctions -e assertions:=assert-count",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-matching-test-cases -e pattern:=catch",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -e expectedFailuresPath:=ExpectedFailures.xml -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -e dependency:=higherOrderFunctions_false -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -e assertions:=assert-count -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod-Literal -e verbose:=true -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-set  -e testSetName:=fn-matches -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-case -e testSetName:=prod-Literal -e testCaseName:=Literals001 -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-and-report -o results_Zorba_XQ30.xml --indent --disable-http-resolution",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=report -e resultsFilePath:=results.xml -o results_Zorba_XQ30.xml --indent",
    "zorba -f -q /path/to/cli.xq -e mode:=generate-expected-failures -e resultsFilePath:=failures.xml -o ExpectedFailures.xml --indent",
    ""
    ), "
")
};

(:~
 : Tokenize a string that contains a comma-separated list of tokens.
 : Note: if the input string is empty, the function returns the empty sequence.
 :)
declare %private function local:tokenize(
  $input as xs:string
) as xs:string*
{
  tokenize($input, ",")
};

variable $fotsPathMsg := "The path to FOTS catalog.xml was set to: ";

variable $testSetPrefixesMsg := "'testSetPrefixes' was set to: ";

variable $testSetNameMsg := "'testSetName' was set to: ";

variable $testCasePrefixesMsg := "'testCasePrefixes' was set to: ";

variable $testCaseNameMsg := "'testCaseName' was set to: ";

switch ($mode)

case "list-test-sets"
return
{
  trace($fotsPath, $fotsPathMsg);
  trace($testSetPrefixes, $testSetPrefixesMsg);

  string-join
  (
  (
    d:list-test-sets($fotsPath, local:tokenize($testSetPrefixes))
  ),
  "
"
  )
}

case "list-test-cases"
return
{
  trace($fotsPath, $fotsPathMsg);
  trace($testSetPrefixes, $testSetPrefixesMsg);
  trace($dependency, "'dependency' set to:");
  trace($assertions, "'assertions' set to: ");

  string-join
  (
  (
    d:list-test-cases($fotsPath,
                      d:list-test-sets($fotsPath, local:tokenize($testSetPrefixes)),
                      $dependency,
                      $assertions)
  ),
  "
"
  )
}

case "list-matching-test-cases"
return
{
  trace($fotsPath, $fotsPathMsg);
  trace($pattern, "pattern set to: ");
  trace($flags, "flags were set to: ");

  string-join
  (
  (
    d:list-matching-test-cases($fotsPath, $pattern, $flags), ""
  ),
  "
"
  )
}

case "run-test-sets"
return
{
  trace($testSetPrefixes, $testSetPrefixesMsg);
  trace($testCasePrefixes, $testCasePrefixesMsg);
  trace($dependency, "'dependency' set to:");
  trace($assertions, "'assertions' set to: ");
  trace($verbose, "'verbose' set to:");
  trace($mode, "Cli command was set to:");

  d:run-fots($fotsPath,
             $fotsZorbaManifestPath,
             local:tokenize($testSetPrefixes),
             $exceptedTestSets,
             local:tokenize($testCasePrefixes),
             $exceptedTestCases,
             $dependency,
             $assertions,
             xs:boolean($verbose),
             $expectedFailuresPath,
             $mode)
}

case "run-test-set"
return
{
  trace($testSetName, $testSetNameMsg);
  trace($dependency, "'dependency' set to:");
  trace($assertions, "'assertions' set to: ");
  trace($verbose, "'verbose' set to:");
  trace($mode, "Cli command was set to:");

  d:run-test-set($fotsPath,
                 $fotsZorbaManifestPath,
                 $testSetName,
                 $exceptedTestSets,
                 (),
                 $exceptedTestCases,
                 $dependency,
                 $assertions,
                 xs:boolean($verbose),
                 $expectedFailuresPath,
                 $mode)
}

case "run-test-case"
return
{
  trace($testSetName, $testSetNameMsg);
  trace($testCaseName, $testCaseNameMsg);
  trace($verbose, "'verbose' set to:");
  trace($mode, "Cli command was set to:");

  d:run-fots($fotsPath,
             $fotsZorbaManifestPath,
             $testSetName,
             $exceptedTestSets,
             $testCaseName,
             $exceptedTestCases,
             "",
             (),
             xs:boolean($verbose),
             $expectedFailuresPath,
             $mode)
}

case "run-and-report"
return
{
  r:run-and-report($fotsPath,
                   $fotsZorbaManifestPath,
                   $exceptedTestCases,
                   $exceptedTestSets)
}

case "report"
return
{
  r:report($fotsZorbaManifestPath,
           $resultsFilePath)
}

case "generate-expected-failures"
return
{
  r:generate-expected-failures($resultsFilePath)
}

default
return
  local:usage()


[bugfix] The text nodes before the callback were being returned, this meant that the callback wasn't applied to all text nodes

(:~
    KWIC module: formats query results to display keywords in context (KWIC). A configurable
    amount of text is displayed to the left and right of a matching keyword (or phrase).

    The module works with all indexes that support match highlighting (matches are tagged
    with an <exist:match> element or exist:matches attribute). This includes the old
    full text index, the new Lucene-based full text index, as well as the NGram index.

    The kwic:summarize() function represents the main entry point into the module.
    To have more control over the text extraction context, you can also call
    kwic:get-summary() instead. For example, the following snippet will only print the
    first match within a given set of context nodes ($ancestor):

    let $matches := kwic:get-matches($hit)

    for $ancestor in $matches/ancestor::para | $matches/ancestor::title | $matches/ancestor::td

    return

        kwic:get-summary($ancestor, ($ancestor//exist:match, $ancestor//*[@exist:matches])[1], $config)

    The configuration element used by some functions has the following structure:

    <config
        width="character width"
        table="yes|no"
        link="URL to which the match is linked"
        whitespace-text-nodes="collapse|drop|leave"
        debug-text-nodes="yes|no"/>
:)
xquery version "3.0";

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

import module namespace util = "http://exist-db.org/xquery/util";

declare namespace exist = "http://exist.sourceforge.net/NS/exist";

declare variable $kwic:MODE_BEFORE := "before";
declare variable $kwic:MODE_AFTER := "after";

declare %private variable $kwic:CHARS_SUMMARY := 120;
declare %private variable $kwic:CHARS_KWIC := 40;

(:~
	Like fn:substring, but takes a node argument. If the node is an element,
	a new element is created with the same node-name as the old one and the
	shortened text content.
:)
declare
    %private
function kwic:substring($node as item(), $start as xs:integer, $count as xs:integer) as node() {
	let $str := substring($node, $start, $count)
	return
		if ($node instance of element()) then
			element { node-name($node) } { $str }
		else
			text { $str }
};

declare
    %private
function kwic:display-text($text as text()?) as node()? {
    if ($text/parent::exist:match) then
    	{$text}
    else
        $text
};

declare
    %private
function kwic:callback($callback as (function(text(), xs:string) as text()?)?, $node as text(), $mode as xs:string) as text()? {
    if (exists($callback)) then
        $callback($node, $mode)
    else
        $node
};

(:~
	Generate the left-hand context of the match. Returns a sequence of nodes
	and strings, whose total string length is less than or equal to $max characters.

	Note: this function calls itself recursively until $nodes is empty or
	the returned sequence has the desired total string length.
:)
declare
    %private
function kwic:truncate-previous($root as node(), $node as node()?, $truncated as item()*,
	   $max as xs:integer, $chars as xs:integer, $callback as (function(text(), xs:string) as text()?)?) {
	if ($node) then
		let $next := $node/preceding::text()[1] intersect $root//text()
		return
			if (empty($next)) then
				$truncated
			else if ($chars + string-length($next) gt $max) then
			    let $str := kwic:callback($callback, $next, $kwic:MODE_BEFORE)
			    return
    			    if (exists($str)) then
        				let $remaining := $max - $chars
        				return (
        				    text { "..." },
        				    kwic:substring($str, string-length($str) - $remaining + 1, $remaining),
        				    $truncated
        			    )
        			else
        			    kwic:truncate-previous($root, $next, $truncated, $max, $chars, $callback)
			else
				kwic:truncate-previous($root, $next,
				    (kwic:callback($callback, $next, $kwic:MODE_BEFORE), $truncated),
					$max, $chars + string-length($next), $callback)
	else
		$truncated
};

(:~
	Generate the right-hand context of the match. Returns a sequence of nodes
	and strings, whose total string length is less than or equal to $max characters.

	Note: this function calls itself recursively until $nodes is empty or
	the returned sequence has the desired total string length.
:)
declare
    %private
function kwic:truncate-following($root as node(), $node as node()?, $truncated as item()*,
	$max as xs:integer, $chars as xs:integer, $callback as (function(text(), xs:string) as text()?)?) {
	if ($node) then
		let $next := $node/following::text()[1] intersect $root//text()
		return
			if (empty($next)) then
				$truncated
			else if ($chars + string-length($next) gt $max) then
			    let $str := kwic:callback($callback, $next, $kwic:MODE_AFTER)
			    return
    			    if (exists($str)) then
        				let $remaining := $max - $chars
        				return (
                            $truncated, kwic:substring($str, 1, $remaining), text { "..." }
        			    )
        			else
        			    kwic:truncate-following($root, $next, $truncated, $max, $chars, $callback)
			else
				kwic:truncate-following($root, $next,
				    ($truncated, kwic:callback($callback, $next, $kwic:MODE_AFTER)),
					$max, $chars + string-length($next), $callback)
	else
		$truncated
};

(:~
	Computes the total string length of the nodes in the argument sequence
:)
declare
    %private
function kwic:string-length($nodes as item()*) as xs:integer {
	if (exists($nodes)) then
		sum($nodes ! string-length(.))
	else
		0
};

declare
    %private
function kwic:collapse-whitespace-fn($callback as (function(text(), xs:string) as text()?)?) as (function(text(), xs:string) as text()) {
    function($text as text(), $mode as xs:string) as text()? {
        let $text :=
            if (matches($text, "\s+")) then
                text { " " }
            else
                $text
        return
            if (exists($callback)) then
                $callback($text, $mode)
            else
                $text
    }
};

declare
    %private
function kwic:drop-whitespace-fn($callback as (function(text(), xs:string) as text()?)?) as (function(text(), xs:string) as text()?) {
    function($text as text(), $mode as xs:string) as text()? {
        let $text :=
            if (matches($text, "\s+")) then
                ()
            else
                $text
        return
            if (exists($text) and exists($callback)) then
                $callback($text, $mode)
            else
                $text
    }
};

declare
    %private
function kwic:output-text($debug-text-nodes as xs:boolean, $text-nodes as text()*) as node()* {
    if($debug-text-nodes) then
        $text-nodes ! <text-node>{.}</text-node>
    else
        $text-nodes
};

declare function kwic:get-summary($root as node(), $node as element(),
	$config as element(config)?) as element() {
	kwic:get-summary($root, $node, $config, ())
};

(:~
	Print a summary of the match in $node. Output a predefined amount of text to
	the left and the right of the match.

	@param $root root element which should be used as context for the match. It defines the
	    boundaries for the text extraction. Text will be taken from this context.
	@param $node the exist:match element or the element with @exist:macthes attribute to process.
	@param $config configuration element which determines the behaviour of the function
	@param $callback (optional) reference to a callback function which will be called
	once for every text node before it is appended to the displayed text. The function
	should accept 2 parameters: 1) a single text node, 2) a string indicating the
	current direction in which text is appended, i.e. $kwic:MODE_BEFORE or $kwic:MODE_AFTER.
	The function may return the empty sequence if the current node should be ignore
	(e.g. if it belongs to a "footnote" which should not be displayed). Otherwise it should
	return a single string.
:)
declare function kwic:get-summary($root as node(), $node as element(),
	$config as element(config)?,
    $callback as (function(text(), xs:string) as text()?)?
) as element() {
	let $chars := xs:integer(($config/@width, $kwic:CHARS_KWIC)[1])
	let $table := $config/@table = ('yes', 'true')
	let $whitespace-text-nodes := string($config/@whitespace-text-nodes)
	let $debug-text-nodes := $config/@debug-text-nodes = ('yes', 'true')

	let $callback :=
	   if ($whitespace-text-nodes eq "collapse") then
	       kwic:collapse-whitespace-fn($callback)
	   else if ($whitespace-text-nodes eq "drop") then
	       kwic:drop-whitespace-fn($callback)
	   else
	       $callback

	let $prevTrunc := kwic:truncate-previous($root, $node, (), $chars, 0, $callback)
	let $remain :=
		if (not($table)) then
			$chars * 2 - kwic:string-length($prevTrunc)
		else
			$chars
	let $followingTrunc := kwic:truncate-following($root, $node, (), $remain, 0, $callback)
	return
		if (not($table)) then

				{kwic:output-text($debug-text-nodes, $prevTrunc)}
				{
					if ($config/@link) then
						{kwic:output-text($debug-text-nodes, $node/text())}
					else
						{kwic:output-text($debug-text-nodes, $node/text())}
				}
				{kwic:output-text($debug-text-nodes, $followingTrunc)}

		else

				{kwic:output-text($debug-text-nodes, $prevTrunc)}

				{
					if ($config/@link) then
						{kwic:output-text($debug-text-nodes, $node/text())}
					else
						kwic:output-text($debug-text-nodes, $node/text())
				}

				{kwic:output-text($debug-text-nodes, $followingTrunc)}

};

(:~
    Expand the element in $hit. Creates an in-memory copy of the element and marks
    all element matches with an exist:match tag and attribute matches with an
    exist:matches tag, which will be used by all other functions in
    this module. You need to call kwic:expand before kwic:get-summary.
    kwic:summarize will call it automatically.
:)
declare function kwic:expand($hit as element()) as element() {
    util:expand($hit, "expand-xincludes=no highlight-matches=both")
};

(:~
    Return all matches within the specified element, $hit. Matches are returned as
    exist:match elements or elements with exist:matches attribute. The returned nodes
    are part of a new document whose root element is a copy of the specified $hit element.

    @param $hit an arbitrary XML element which has been selected by one of the full text
		operations or an ngram search.
:)
declare function kwic:get-matches($hit as element()) as element()* {
    let $expanded := kwic:expand($hit)
	return ($expanded//exist:match, $expanded//*[@exist:matches])
};

declare function kwic:summarize($hit as element(), $config as element(config)?) as element()* {
    kwic:summarize($hit, $config, ())
};

(:~
	Main function of the KWIC module: takes the passed element and returns an
	XHTML fragment containing a chunk of text before and after the first full text
	match in the node.

	The optional config parameter is used to configure the behaviour of the function:

	<config width="character width" table="yes|no" link="URL to which the match is linked"/>

	By default, kwic:summarize returns an XHTML fragment with the following structure:

	<p xmlns="http://www.w3.org/1999/xhtml">
		<span class="previous">Text before match</span>
		<a href="passed URL if any" class="hi">The highlighted term</a>
		<span class="following">Text after match</span>
	</p>

	If table=yes is passed with the config element, a tr table row will be returned instead
	of a span (using the same class names).

	@param $hit an arbitrary XML element which has been selected by one of the full text
		operations or an ngram search.
	@param $config configuration element to configure the behaviour of the function
:)
declare function kwic:summarize($hit as element(), $config as element(config)?,
    $callback as (function(text(), xs:string) as text()?)?) as element()* {
    let $expanded := util:expand($hit, "expand-xincludes=no highlight-matches=both")
	for $match in ($expanded//exist:match, $expanded//*[@exist:matches])
	return
		kwic:get-summary($expanded, $match, $config, $callback)
};

(:
declare function kwic:summarize-all($hits as element()*, $config as element(config),
    $wrap as function(node(), function(node()) as element()) as element()) {
    let $hits := util:expand($hits, "expand-xincludes=no")
    for $hit in $hits
    return
        $wrap($hit, function($node) {
            for $match in $node//exist:match
            return
        		kwic:get-summary($node, $match, $config, ())
        })
};
:)

(:~
    KWIC module: formats query results to display keywords in context (KWIC). A configurable
    amount of text is displayed to the left and right of a matching keyword (or phrase).

    The module works with all indexes that support match highlighting (matches are tagged
    with an <exist:match> element or exist:matches attribute). This includes the old
    full text index, the new Lucene-based full text index, as well as the NGram index.

    The kwic:summarize() function represents the main entry point into the module.
    To have more control over the text extraction context, you can also call
    kwic:get-summary() instead. For example, the following snippet will only print the
    first match within a given set of context nodes ($ancestor):

    let $matches := kwic:get-matches($hit)

    for $ancestor in $matches/ancestor::para | $matches/ancestor::title | $matches/ancestor::td

    return

        kwic:get-summary($ancestor, ($ancestor//exist:match, $ancestor//*[@exist:matches])[1], $config)

    The configuration element used by some functions has the following structure:

    <config
        width="character width"
        table="yes|no"
        link="URL to which the match is linked"
        whitespace-text-nodes="collapse|drop|leave"
        debug-text-nodes="yes|no"/>
:)
xquery version "3.0";

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

import module namespace util = "http://exist-db.org/xquery/util";

declare namespace exist = "http://exist.sourceforge.net/NS/exist";

declare variable $kwic:MODE_BEFORE := "before";
declare variable $kwic:MODE_AFTER := "after";

declare %private variable $kwic:CHARS_SUMMARY := 120;
declare %private variable $kwic:CHARS_KWIC := 40;

(:~
	Like fn:substring, but takes a node argument. If the node is an element,
	a new element is created with the same node-name as the old one and the
	shortened text content.
:)
declare
    %private
function kwic:substring($node as item(), $start as xs:integer, $count as xs:integer) as node() {
	let $str := substring($node, $start, $count)
	return
		if ($node instance of element()) then
			element { node-name($node) } { $str }
		else
			text { $str }
};

declare
    %private
function kwic:display-text($text as text()?) as node()? {
    if ($text/parent::exist:match) then
    	{$text}
    else
        $text
};

declare
    %private
function kwic:callback($callback as (function(text(), xs:string) as text()?)?, $node as text(), $mode as xs:string) as text()? {
    if (exists($callback)) then
        $callback($node, $mode)
    else
        $node
};

(:~
	Generate the left-hand context of the match. Returns a sequence of nodes
	and strings, whose total string length is less than or equal to $max characters.

	Note: this function calls itself recursively until $nodes is empty or
	the returned sequence has the desired total string length.
:)
declare
    %private
function kwic:truncate-previous($root as node(), $node as node()?, $truncated as item()*,
	   $max as xs:integer, $chars as xs:integer, $callback as (function(text(), xs:string) as text()?)?) {
	if ($node) then
		let $next := $node/preceding::text()[1] intersect $root//text()
		return
			if (empty($next)) then
				$truncated
			else if ($chars + string-length($next) gt $max) then
			    let $str := kwic:callback($callback, $next, $kwic:MODE_BEFORE)
			    return
    			    if (exists($str)) then
        				let $remaining := $max - $chars
        				return (
        				    text { "..." },
        				    kwic:substring($str, string-length($str) - $remaining + 1, $remaining),
        				    $truncated
        			    )
        			else
        			    kwic:truncate-previous($root, $next, $truncated, $max, $chars, $callback)
			else
				kwic:truncate-previous($root, $next,
				    (kwic:callback($callback, $next, $kwic:MODE_BEFORE), $truncated),
					$max, $chars + string-length($next), $callback)
	else
		$truncated
};

(:~
	Generate the right-hand context of the match. Returns a sequence of nodes
	and strings, whose total string length is less than or equal to $max characters.

	Note: this function calls itself recursively until $nodes is empty or
	the returned sequence has the desired total string length.
:)
declare
    %private
function kwic:truncate-following($root as node(), $node as node()?, $truncated as item()*,
	$max as xs:integer, $chars as xs:integer, $callback as (function(text(), xs:string) as text()?)?) {
	if ($node) then
		let $next := $node/following::text()[1] intersect $root//text()
		return
			if (empty($next)) then
				$truncated
			else if ($chars + string-length($next) gt $max) then
			    let $str := kwic:callback($callback, $next, $kwic:MODE_AFTER)
			    return
    			    if (exists($str)) then
        				let $remaining := $max - $chars
        				return (
        				    $truncated, kwic:substring($next, 1, $remaining), text { "..." }
        			    )
        			else
        			    kwic:truncate-following($root, $next, $truncated, $max, $chars, $callback)
			else
				kwic:truncate-following($root, $next,
				    ($truncated, kwic:callback($callback, $next, $kwic:MODE_AFTER)),
					$max, $chars + string-length($next), $callback)
	else
		$truncated
};

(:~
	Computes the total string length of the nodes in the argument sequence
:)
declare
    %private
function kwic:string-length($nodes as item()*) as xs:integer {
	if (exists($nodes)) then
		sum($nodes ! string-length(.))
	else
		0
};

declare
    %private
function kwic:collapse-whitespace-fn($callback as (function(text(), xs:string) as text()?)?) as (function(text(), xs:string) as text()) {
    function($text as text(), $mode as xs:string) as text()? {
        let $text :=
            if (matches($text, "\s+")) then
                text { " " }
            else
                $text
        return
            if (exists($callback)) then
                $callback($text, $mode)
            else
                $text
    }
};

declare
    %private
function kwic:drop-whitespace-fn($callback as (function(text(), xs:string) as text()?)?) as (function(text(), xs:string) as text()?) {
    function($text as text(), $mode as xs:string) as text()? {
        let $text :=
            if (matches($text, "\s+")) then
                ()
            else
                $text
        return
            if (exists($text) and exists($callback)) then
                $callback($text, $mode)
            else
                $text
    }
};

declare
    %private
function kwic:output-text($debug-text-nodes as xs:boolean, $text-nodes as text()*) as node()* {
    if($debug-text-nodes) then
        $text-nodes ! <text-node>{.}</text-node>
    else
        $text-nodes
};

declare function kwic:get-summary($root as node(), $node as element(),
	$config as element(config)?) as element() {
	kwic:get-summary($root, $node, $config, ())
};

(:~
	Print a summary of the match in $node. Output a predefined amount of text to
	the left and the right of the match.

	@param $root root element which should be used as context for the match. It defines the
	    boundaries for the text extraction. Text will be taken from this context.
	@param $node the exist:match element or the element with @exist:macthes attribute to process.
	@param $config configuration element which determines the behaviour of the function
	@param $callback (optional) reference to a callback function which will be called
	once for every text node before it is appended to the displayed text. The function
	should accept 2 parameters: 1) a single text node, 2) a string indicating the
	current direction in which text is appended, i.e. $kwic:MODE_BEFORE or $kwic:MODE_AFTER.
	The function may return the empty sequence if the current node should be ignore
	(e.g. if it belongs to a "footnote" which should not be displayed). Otherwise it should
	return a single string.
:)
declare function kwic:get-summary($root as node(), $node as element(),
	$config as element(config)?,
    $callback as (function(text(), xs:string) as text()?)?
) as element() {
	let $chars := xs:integer(($config/@width, $kwic:CHARS_KWIC)[1])
	let $table := $config/@table = ('yes', 'true')
	let $whitespace-text-nodes := string($config/@whitespace-text-nodes)
	let $debug-text-nodes := $config/@debug-text-nodes = ('yes', 'true')

	let $callback :=
	   if ($whitespace-text-nodes eq "collapse") then
	       kwic:collapse-whitespace-fn($callback)
	   else if ($whitespace-text-nodes eq "drop") then
	       kwic:drop-whitespace-fn($callback)
	   else
	       $callback

	let $prevTrunc := kwic:truncate-previous($root, $node, (), $chars, 0, $callback)
	let $remain :=
		if (not($table)) then
			$chars * 2 - kwic:string-length($prevTrunc)
		else
			$chars
	let $followingTrunc := kwic:truncate-following($root, $node, (), $remain, 0, $callback)
	return
		if (not($table)) then

				{kwic:output-text($debug-text-nodes, $prevTrunc)}
				{
					if ($config/@link) then
						{kwic:output-text($debug-text-nodes, $node/text())}
					else
						{kwic:output-text($debug-text-nodes, $node/text())}
				}
				{kwic:output-text($debug-text-nodes, $followingTrunc)}

		else

				{kwic:output-text($debug-text-nodes, $prevTrunc)}

				{
					if ($config/@link) then
						{kwic:output-text($debug-text-nodes, $node/text())}
					else
						kwic:output-text($debug-text-nodes, $node/text())
				}

				{kwic:output-text($debug-text-nodes, $followingTrunc)}

};

(:~
    Expand the element in $hit. Creates an in-memory copy of the element and marks
    all element matches with an exist:match tag and attribute matches with an
    exist:matches tag, which will be used by all other functions in
    this module. You need to call kwic:expand before kwic:get-summary.
    kwic:summarize will call it automatically.
:)
declare function kwic:expand($hit as element()) as element() {
    util:expand($hit, "expand-xincludes=no highlight-matches=both")
};

(:~
    Return all matches within the specified element, $hit. Matches are returned as
    exist:match elements or elements with exist:matches attribute. The returned nodes
    are part of a new document whose root element is a copy of the specified $hit element.

    @param $hit an arbitrary XML element which has been selected by one of the full text
		operations or an ngram search.
:)
declare function kwic:get-matches($hit as element()) as element()* {
    let $expanded := kwic:expand($hit)
	return ($expanded//exist:match, $expanded//*[@exist:matches])
};

declare function kwic:summarize($hit as element(), $config as element(config)?) as element()* {
    kwic:summarize($hit, $config, ())
};

(:~
	Main function of the KWIC module: takes the passed element and returns an
	XHTML fragment containing a chunk of text before and after the first full text
	match in the node.

	The optional config parameter is used to configure the behaviour of the function:

	<config width="character width" table="yes|no" link="URL to which the match is linked"/>

	By default, kwic:summarize returns an XHTML fragment with the following structure:

	<p xmlns="http://www.w3.org/1999/xhtml">
		<span class="previous">Text before match</span>
		<a href="passed URL if any" class="hi">The highlighted term</a>
		<span class="following">Text after match</span>
	</p>

	If table=yes is passed with the config element, a tr table row will be returned instead
	of a span (using the same class names).

	@param $hit an arbitrary XML element which has been selected by one of the full text
		operations or an ngram search.
	@param $config configuration element to configure the behaviour of the function
:)
declare function kwic:summarize($hit as element(), $config as element(config)?,
    $callback as (function(text(), xs:string) as text()?)?) as element()* {
    let $expanded := util:expand($hit, "expand-xincludes=no highlight-matches=both")
	for $match in ($expanded//exist:match, $expanded//*[@exist:matches])
	return
		kwic:get-summary($expanded, $match, $config, $callback)
};

(:
declare function kwic:summarize-all($hits as element()*, $config as element(config),
    $wrap as function(node(), function(node()) as element()) as element()) {
    let $hits := util:expand($hits, "expand-xincludes=no")
    for $hit in $hits
    return
        $wrap($hit, function($node) {
            for $match in $node//exist:match
            return
        		kwic:get-summary($node, $match, $config, ())
        })
};
:)