reordered the functions inside environment.xq

(:
 : 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 environment
 : @author Sorin Nasoi
 :)

module namespace env =
  "http://www.zorba-xquery.com/fots-driver/environment";

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

declare namespace fots =
  "http://www.w3.org/2010/09/qt-fots-catalog";

declare namespace ann =
  "http://www.zorba-xquery.com/annotations";

declare variable $env:hof as xs:string :=
  string-join(
    ( "declare namespace op = 'http://www.zorba-xquery.com/options/features';",
      "declare namespace f = 'http://www.zorba-xquery.com/features';",
      "declare option op:enable 'f:hof';"),
    "
");

(:~
 : If there is a dependency on XQuery 3.0 and there is at least one HOF
 : function in the test, return the strings for enabling the HOF feature.
 :
 : @param $deps the dependencies of the test set and test case
 : @param $test the Query test.
 : @return the strings for enabling the HOF feature
 :)
declare function env:enable-HOF-feature(
  $deps as element(fots:dependency)*,
  $test as xs:string
) as xs:string?
{
  let $depSpec := string-join(distinct-values( for $dep in $deps
                                               where $dep[@type="spec"]
                                               return data($dep/@value)),""),
      $depFeature := string-join(distinct-values(for $dep in $deps
                                                 where $dep[@type="feature"]
                                                 return data($dep/@value)),"")
  return
    if ((contains($depSpec,"XQ30") or contains($depSpec,"XP30")) and
         contains($depFeature,"higherOrderFunctions"))
    then $env:hof else ()
};

(:~
 : Check if an XQuery version declaration needs to be added.
 :
 : @param $deps the dependencies of the test set and test case.
 : @param $test the Query test.
 : @return the XQuery version declaration.
 :)
declare function env:add-xquery-30(
  $deps as element(fots:dependency)*,
  $test as xs:string
) as xs:string?
{
  let $dependencies := string-join(distinct-values(for $dep in $deps
                                                   where $dep[@type="spec"]
                                                   return data($dep/@value)),"")
  return
    if ((contains($dependencies,"XQ30") or contains($dependencies,"XP30")) and
        not(contains($test, "xquery version ")))
    then 'xquery version "3.0";'
    else ()
};

(:~
 : Sets the declared default element namespace.
 :
 : @param $env the environment of the catalog/test-set (given with 'ref').
 : @param $envCase the environment of the test-case.
 : @return the declare default element namespace.
 :)
declare function env:decl-def-elem-namespace(
  $env      as element(fots:environment)?,
  $envCase  as element(fots:environment)?
) as xs:string?
{
  for $ns in ($env/fots:namespace, $envCase/fots:namespace)
  where $ns[@prefix=""]
  return concat('declare default element namespace "',
                 data($ns/@uri),
                '";')
};

(:~
 : Adds the declare namespace statements.
 :
 : @param $env the environment of the catalog/test-set (given with 'ref').
 : @param $case the test-case.
 : @param $testSetBaseURI the URI of the test set file.
 : @return the declare namespace statements.
 :)
declare %ann:nondeterministic function env:decl-namespaces(
  $env            as element(fots:environment)?,
  $case           as element(fots:test-case),
  $testSetBaseURI as xs:anyURI
) as xs:string?
{
  string-join(
    for $ns in ($env/fots:namespace, $case/fots:environment/fots:namespace)
    where not($ns[@prefix=""]) and
          not(env:is-schema-prefix-bound(data($ns/@prefix),
                                        $case,
                                        $testSetBaseURI))
    return concat('declare namespace ',
                  data($ns/@prefix),
                  ' = "',
                  data($ns/@uri),
                  '";')
              ," ")
};

(:~
 : Return true if the prefix will be bound to a schema in the Query
 : It's a bug in the FOTS if this function returns true: TODO report to W3C
 :)
declare %private %ann:nondeterministic function env:is-schema-prefix-bound(
  $prefix         as xs:string,
  $case           as element(fots:test-case),
  $testSetBaseURI as xs:anyURI
) as xs:boolean
{
  contains(util:get-value($case,
                          $testSetBaseURI,
                          "test"),
            concat("import schema namespace ",
                  $prefix))
};

(:~
 : Returns the the declare base-uri prolog statement.
 :
 : @param $env the environment of the catalog/test-set (given with 'ref').
 : @param $envCase the environment of the test-case.
 : @return the declare base-uri prolog statement.
 :)
declare function env:decl-base-uri(
  $env      as element(fots:environment)?,
  $envCase  as element(fots:environment)?
) as xs:string?
{
  for $baseURI in ($env/fots:static-base-uri, $envCase/fots:static-base-uri)
  return concat("declare base-uri '",
                 data($baseURI/@uri),
                "';")
};

(:~
 : Add the decimal format declarations.
 :
 : @param $decimal-formats decimal formats.
 : @return the decimal formats declarations.
 :)
declare function env:decl-decimal-formats(
  $decimal-formats as element(fots:decimal-format)*
) as xs:string*
{
  if(empty($decimal-formats))
  then ()
  else
    for $tmp in $decimal-formats
    let $default := if(exists($tmp/@name))
                    then ()
                    else "default"
    let $name :=  if(exists($tmp/@name))
                  then data($tmp/@name)
                  else ()
    return
      string-join(("declare",
                    $default,
                    "decimal-format",
                    $name,
                    env:set-properties($tmp),
                    ";"),' ')
};

declare %private function env:set-properties(
  $decimal-format as element(fots:decimal-format)
) as xs:string*
{
  for $att in $decimal-format/attribute::*
  let $name := node-name($att)
  let $value := data($att)
  return
    if(exists(index-of(("decimal-separator", "grouping-separator", "infinity",
                        "minus-sign", "NaN", "percent", "per-mille",
                        "zero-digit", "digit", "pattern-separator"),
                        xs:string($name))))
    then concat($name, '="' , $value, '"')
    else ()
};

(:~
 : Adds the variable declarations.
 : @param $env environment.
 : @param $case test case.
 : @param $envBaseURI the relative URI for the environment.
 : @param $testSetBaseURI the URI of the test set.
 : @return the variable declarations.
 :)
declare %ann:nondeterministic function env:add-var-decl(
  $env            as element(fots:environment)?,
  $case           as element(fots:test-case),
  $envBaseURI     as xs:anyURI,
  $testSetBaseURI as xs:anyURI
) as xs:string?
{
  concat( env:var-decl-with-value($env,
                                  $envBaseURI),
          env:var-decl-with-value($case/fots:environment,
                                  $testSetBaseURI),
          env:var-decl-without-value($env,
                                     $case/fots:environment))
};

declare %private function env:var-decl-with-value(
  $env      as element(fots:environment)?,
  $baseURI  as xs:anyURI
) as xs:string?
{
  string-join(
    for $param in $env/fots:param
    let $select := $param/@select
    let $file := $env/fots:source[@uri = translate($select, "'", "")]/@file
    let $type := $param/@as
    let $varValue := if(starts-with($select, "'") and ends-with($select, "'"))
                     then  concat('"',
                                 resolve-uri($file, $baseURI),
                                 '"')
                     else $select
    where (exists($select) and
(: if there is an attribute 'declared' set to true, this means that the variable
   is declared within the 'test' itself so no additional variable declaration
   is needed :)
           empty($param[@declared="true"]))
    return concat("declare variable $",
                  $param/@name,
                  ((concat(" as ", $type)))[$type],
                  " := ",
                  $varValue,
                  ";")
   ," ")
};

declare %private function env:var-decl-without-value(
  $env      as element(fots:environment)?,
  $envCase  as element(fots:environment)?
) as xs:string?
{
  string-join(
    (for $param in ($env/fots:param, $envCase/fots:param)
     let $select := $param/@select
     let $type := $param/@as
     where (empty($select) and
            empty($param[@declared="true"]))
     return concat("declare variable $",
                   $param/@name,
                   ((concat(" as ", $type)))[$type],
                   " external;"),
     for $source in ($env/fots:source, $envCase/fots:source)
     let $role := $source/@role
     where starts-with($role,"$")
     return concat("declare variable ",
                   $role,
                   " external;"))
   ," ")
};

(:~
 : Returns the string for setting the context item if needed.
 : @param $env environment.
 : @param $envBaseURI test base URI of the environment.
 : @return the string for setting the context item if needed.
 :)
declare function env:set-context-item(
  $env        as element(fots:environment)?,
  $envBaseURI as xs:anyURI?
) as xs:string? {
  if (exists($env/fots:source[@role = "."]))
  then string-join((env:declare-context-item($env, $envBaseURI),
                   'xqxq:bind-context-item($queryID, $contextItem);')
                   ,"
")
  else ()
};

declare %private function env:declare-context-item(
  $env        as element(fots:environment)?,
  $envBaseURI as xs:anyURI?
) as xs:string
{
  let $ciURI := resolve-uri($env/fots:source[@role = "."]/@file, $envBaseURI)
  return
  if(empty($env/fots:source[@validation = "strict"]))
  then concat('variable $contextItem := doc("', $ciURI, '");')
  else string-join(
    ("
",
     "variable $contextItemQuery := xqxq:prepare-main-module('",
     env:get-schema-import($env),
     concat('validate { doc("', $ciURI, '")', "}',", " "),
           "resolver:url-resolver#2, ());",
           "variable $contextItem := xqxq:evaluate($contextItemQuery);")
   ,"
")
};

(:~
 : Returns the strings for variable binding in XQXQ.
 :
 : @param $env the environment of the catalog/test-set (given with 'ref').
 : @param $envBaseURI the relative URI for the environment.
 : @return the strings for variable binding in XQXQ.
 :)
declare function env:set-variables(
  $env        as element(fots:environment)?,
  $envBaseURI as xs:anyURI
) as xs:string?
{
  if(empty($env))
  then ()
  else
    let $srcNames := for $source in $env/fots:source
                     where starts-with(data($source/@role),"$")
                     return substring-after(data($source/@role),"$"),
        $srcValues := for $srcName in $srcNames
                      return concat('doc("',
                                  resolve-uri($env/fots:source[@role = concat("$",$srcName)]/@file, $envBaseURI),
                                  '")')
  return
  string-join(
    (for $srcName in $srcNames
     let $index := index-of($srcNames, $srcName)
     return
      concat('xqxq:bind-variable( $queryID, xs:QName("', $srcName, '")', ', ',
             $srcValues[$index], ');'),
      for $param in $env/fots:param
      let $select:= $param/@select
      let $varValue := if(starts-with($select, "'") and ends-with($select, "'"))
                      then  concat('"',
                                  resolve-uri($env/fots:source[@uri = translate($select, "'", "")]/@file, $envBaseURI),
                                  '"')
                      else $select
      let $varName := $param/@name
      where (exists($select) and
(: if there is an attribute 'declared' set to true, this means that the variable
   is declared within the 'test' itself :)
             exists($param[@declared="true"]))
      return
        concat('xqxq:bind-variable( $queryID, xs:QName("',
               $param/@name,
               '")', ', ',
               $varValue, ');'))
    , "
")
};

declare %private function env:get-schema-import (
  $env  as element(fots:environment)?
) as xs:string
{
  if (empty($env))
  then ""
  else
    let $namespace := $env/fots:namespace[@uri = data($env/fots:schema/@uri)]
    let $prefix as xs:string := if(exists($namespace))
                                then xs:string(data($namespace/@prefix))
                                else "p"
    return
      if($prefix = "")
      then concat('import schema default element namespace "',
                  $env/fots:schema/@uri,
                  '";
')
      else concat('import schema namespace ',
                  $prefix,
                  ' = "',
                  $env/fots:schema/@uri,
                  '";
')
};

(:~
 : Returns the XQXQ URL resolver declaration.
 : @param $case the test case.
 : @param $env the environment.
 : @param $envBaseURI URI of the environment.
 : @param $testSetBaseURI URI to the test set that defines the test case.
 : @return the XQXQ URL resolver declaration.
 :)
declare function env:resolver(
  $case           as element(fots:test-case),
  $env            as element(fots:environment)?,
  $envBaseURI     as xs:anyURI?,
  $testSetBaseURI as xs:anyURI
) as xs:string?
{
  let $envSchema := $env/fots:schema,
      $tcSchema := $case/fots:environment/fots:schema,
      $schemas := ($envSchema, $tcSchema),
      $modules := $case/fots:module,
      $resources := ($env/fots:resource, $case/fots:environment/fots:schema)
  return
    if (empty($schemas) and empty($modules) and empty($resources))
    then ()
    else string-join(
            ("declare namespace resolver = 'http://www.zorba-xquery.com/modules/xqxq/url-resolver';",
             $env:hof,
            "declare function resolver:url-resolver($namespace as xs:string, $entity as xs:string) {",
            "switch($entity)",
    if (exists($schemas))
    then string-join(("case 'schema'",
                     "  return switch($namespace)",
                    (for $schema in $envSchema
                     return concat("    case '",
                                  data($schema/@uri),
                                   "' return doc('",
                                   resolve-uri($schema/@file, $envBaseURI),
                                   "')"),
                      for $schema in $tcSchema
                      return concat("    case '",
                                   data($schema/@uri),
                                   "' return doc('",
                                   resolve-uri($schema/@file, $testSetBaseURI),
                                   "')")),
                      "    default return ()"),
                      "
")
    else (),
    if (exists($modules))
    then string-join(("case 'module'",
                      "  return switch($namespace)",
                      for $module in $modules
                      return concat("    case '",
                                   data($module/@uri),
                                   "' return unparsed-text('",
                                   resolve-uri($module/@file, $testSetBaseURI),
                                   "') "),
                    "    default return ()"),
                    "
")
    else (),
    if (exists($resources)) then
    string-join(("case ''",
                 "  return switch($namespace)",
                  for $resource in $resources
                  return concat("    case '",
                                 data($resource/@uri),
                                 "' return unparsed-text('",
                                 resolve-uri($resource/@file, $envBaseURI),
                                 "'",
                                 if(exists($resource/@encoding))
                                 then concat (",'",
                                              data($resource/@encoding),
                                              "'")
                                 else (),
                                 ") "),
                 "         default return ()")
                ,"
")
    else ()
    , "default return ()","};"),
    "
")
};

(:~
 : Checks the dependencies according to the Zorba manifest.
 :
 : @param $deps the dependencies of the test set and test case
 : @param $zorbaManifest Zorba manifest document.
 : @return if true empty string, otherwise returns a string with the
 : dependencies that were not matched.
 :)
declare function env:check-dependencies(
  $deps           as element(fots:dependency)*,
  $zorbaManifest
) as xs:string*
{
  if(empty($deps))
  then ()
  else
    for $dep in $deps
    let $satisfied := if(exists($dep/@satisfied))
                      then data($dep/@satisfied)
                      else "true"
    let $zorbaDep := $zorbaManifest//fots:dependency[ @type = $dep/@type and
                                                      @value = $dep/@value and
                                                      @satisfied = $satisfied]
    return
      if(empty($zorbaDep))
      then concat("Dependency (type=",
                  $dep/@type,
                  ", value=",
                  $dep/@value,
                  ", satisfied=",
                  $satisfied,
                  ") was not met. ")
      else ()
};

(:~
 : Retrieves the environment from a test-set/catalog given an environment name.
 : @param $catalog FOTS catalog file.
 : @param $testSet test set.
 : @param $envName name of the environment.
 : @return the environment with the given name.
 :)
declare function env:get-environment (
  $catalog,
  $testSet  as element (fots:test-set),
  $envName  as xs:string
) as element(fots:environment)?
{
  let $envTestSet := $testSet/test-set//environment[@name = $envName]
  return
    if (empty($envTestSet))
    then $catalog/catalog//environment[@name = $envName]
    else $envTestSet
};

(:
 : 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 environment
 : @author Sorin Nasoi
 :)

module namespace env =
  "http://www.zorba-xquery.com/fots-driver/environment";

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

declare namespace fots =
  "http://www.w3.org/2010/09/qt-fots-catalog";

declare namespace ann =
  "http://www.zorba-xquery.com/annotations";

declare variable $env:hof as xs:string :=
  string-join(
    ( "declare namespace op = 'http://www.zorba-xquery.com/options/features';",
      "declare namespace f = 'http://www.zorba-xquery.com/features';",
      "declare option op:enable 'f:hof';"),
    "
");

(:~
 : Retrieves the environment from a test-set/catalog given an environment name.
 : @param $catalog FOTS catalog file.
 : @param $testSet test set.
 : @param $envName name of the environment.
 : @return the environment with the given name.
 :)
declare function env:get-environment (
  $catalog,
  $testSet  as element (fots:test-set),
  $envName  as xs:string
) as element(fots:environment)? {
  let $envTestSet := $testSet/test-set//environment[@name = $envName]
  return
    if (empty($envTestSet))
    then $catalog/catalog//environment[@name = $envName]
    else $envTestSet
};

(:~
 : Adds the variable declarations.
 : @param $env environment.
 : @param $case test case.
 : @param $envBaseURI the relative URI for the environment.
 : @param $testSetBaseURI the URI of the test set.
 : @return the variable declarations.
 :)
declare %ann:nondeterministic function env:add-var-decl(
  $env            as element(fots:environment)?,
  $case           as element(fots:test-case),
  $envBaseURI     as xs:anyURI,
  $testSetBaseURI as xs:anyURI
) as xs:string? {
  concat( env:var-decl-with-value($env,
                                  $envBaseURI),
          env:var-decl-with-value($case/fots:environment,
                                  $testSetBaseURI),
          env:var-decl-without-value($env,
                                     $case/fots:environment))
};

(:~
 : Returns the string for setting the context item if needed.
 : @param $env environment.
 : @param $envBaseURI test base URI of the environment.
 : @return the string for setting the context item if needed.
 :)
declare function env:set-context-item(
  $env        as element(fots:environment)?,
  $envBaseURI as xs:anyURI?
) as xs:string? {
  if (exists($env/fots:source[@role = "."]))
  then string-join((env:declare-context-item($env, $envBaseURI),
                   'xqxq:bind-context-item($queryID, $contextItem);')
                   ,"
")
  else ()
};

(:~
 : Returns the strings for variable binding in XQXQ.
 :
 : @param $env the environment of the catalog/test-set (given with 'ref').
 : @param $envBaseURI the relative URI for the environment.
 : @return the strings for variable binding in XQXQ.
 :)
declare function env:set-variables(
  $env        as element(fots:environment)?,
  $envBaseURI as xs:anyURI
) as xs:string? {
  if(empty($env))
  then ()
  else
    let $srcNames := for $source in $env/fots:source
                     where starts-with(data($source/@role),"$")
                     return substring-after(data($source/@role),"$"),
        $srcValues := for $srcName in $srcNames
                      return concat('doc("',
                                  resolve-uri($env/fots:source[@role = concat("$",$srcName)]/@file, $envBaseURI),
                                  '")')
  return
  string-join(
    (for $srcName in $srcNames
     let $index := index-of($srcNames, $srcName)
     return
      concat('xqxq:bind-variable( $queryID, xs:QName("', $srcName, '")', ', ',
             $srcValues[$index], ');'),
      for $param in $env/fots:param
      let $select:= $param/@select
      let $varValue := if(starts-with($select, "'") and ends-with($select, "'"))
                      then  concat('"',
                                  resolve-uri($env/fots:source[@uri = translate($select, "'", "")]/@file, $envBaseURI),
                                  '"')
                      else $select
      let $varName := $param/@name
      where (exists($select) and
(: if there is an attribute 'declared' set to true, this means that the variable
   is declared within the 'test' itself :)
             exists($param[@declared="true"]))
      return
        concat('xqxq:bind-variable( $queryID, xs:QName("',
               $param/@name,
               '")', ', ',
               $varValue, ');'))
    , "
")
};

(:~
 : Adds the declare namespace statements.
 :
 : @param $env the environment of the catalog/test-set (given with 'ref').
 : @param $case the test-case.
 : @param $testSetBaseURI the URI of the test set file.
 : @return the declare namespace statements.
 :)
declare %ann:nondeterministic function env:decl-namespaces(
  $env            as element(fots:environment)?,
  $case           as element(fots:test-case),
  $testSetBaseURI as xs:anyURI
) as xs:string? {
  string-join(
    for $ns in ($env/fots:namespace, $case/fots:environment/fots:namespace)
    where not($ns[@prefix=""]) and
          not(env:is-schema-prefix-bound(data($ns/@prefix),
                                        $case,
                                        $testSetBaseURI))
    return concat('declare namespace ',
                  data($ns/@prefix),
                  ' = "',
                  data($ns/@uri),
                  '";')
              ," ")
};

(:~
 : Sets the declared default element namespace.
 :
 : @param $env the environment of the catalog/test-set (given with 'ref').
 : @param $envCase the environment of the test-case.
 : @return the declare default element namespace.
 :)
declare function env:decl-def-elem-namespace(
  $env      as element(fots:environment)?,
  $envCase  as element(fots:environment)?
) as xs:string? {
  for $ns in ($env/fots:namespace, $envCase/fots:namespace)
  where $ns[@prefix=""]
  return concat('declare default element namespace "',
                 data($ns/@uri),
                '";')
};

(:~
 : Returns the the declare base-uri prolog statement.
 :
 : @param $env the environment of the catalog/test-set (given with 'ref').
 : @param $envCase the environment of the test-case.
 : @return the declare base-uri prolog statement.
 :)
declare function env:decl-base-uri(
  $env      as element(fots:environment)?,
  $envCase  as element(fots:environment)?
) as xs:string? {
  for $baseURI in ($env/fots:static-base-uri, $envCase/fots:static-base-uri)
  return concat("declare base-uri '",
                 data($baseURI/@uri),
                "';")
};
(:~
 : Return true if the prefix will be bound to a schema in the Query
 : It's a bug in the FOTS if this function returns true: TODO report to W3C
 :)
declare %private %ann:nondeterministic function env:is-schema-prefix-bound(
  $prefix         as xs:string,
  $case           as element(fots:test-case),
  $testSetBaseURI as xs:anyURI
) as xs:boolean {
  contains(util:get-value($case,
                          $testSetBaseURI,
                          "test"),
            concat("import schema namespace ",
                  $prefix))
};

declare %private function env:get-schema-import (
  $env  as element(fots:environment)?
) as xs:string {
  if (empty($env))
  then ""
  else
    let $namespace := $env/fots:namespace[@uri = data($env/fots:schema/@uri)]
    let $prefix as xs:string := if(exists($namespace))
                                then xs:string(data($namespace/@prefix))
                                else "p"
    return
      if($prefix = "")
      then concat('import schema default element namespace "',
                  $env/fots:schema/@uri,
                  '";
')
      else concat('import schema namespace ',
                  $prefix,
                  ' = "',
                  $env/fots:schema/@uri,
                  '";
')
};

declare %private function env:var-decl-with-value(
  $env      as element(fots:environment)?,
  $baseURI  as xs:anyURI
) as xs:string? {
  string-join(
    for $param in $env/fots:param
    let $select := $param/@select
    let $file := $env/fots:source[@uri = translate($select, "'", "")]/@file
    let $type := $param/@as
    let $varValue := if(starts-with($select, "'") and ends-with($select, "'"))
                     then  concat('"',
                                 resolve-uri($file, $baseURI),
                                 '"')
                     else $select
    where (exists($select) and
(: if there is an attribute 'declared' set to true, this means that the variable
   is declared within the 'test' itself so no additional variable declaration
   is needed :)
           empty($param[@declared="true"]))
    return concat("declare variable $",
                  $param/@name,
                  ((concat(" as ", $type)))[$type],
                  " := ",
                  $varValue,
                  ";")
   ," ")
};

declare %private function env:var-decl-without-value(
  $env      as element(fots:environment)?,
  $envCase  as element(fots:environment)?
) as xs:string? {
  string-join(
    (for $param in ($env/fots:param, $envCase/fots:param)
     let $select := $param/@select
     let $type := $param/@as
     where (empty($select) and
            empty($param[@declared="true"]))
     return concat("declare variable $",
                   $param/@name,
                   ((concat(" as ", $type)))[$type],
                   " external;"),
     for $source in ($env/fots:source, $envCase/fots:source)
     let $role := $source/@role
     where starts-with($role,"$")
     return concat("declare variable ",
                   $role,
                   " external;"))
   ," ")
};

declare %private function env:declare-context-item(
  $env        as element(fots:environment)?,
  $envBaseURI as xs:anyURI?
) as xs:string {
  let $ciURI := resolve-uri($env/fots:source[@role = "."]/@file, $envBaseURI)
  return
  if(empty($env/fots:source[@validation = "strict"]))
  then concat('variable $contextItem := doc("', $ciURI, '");')
  else string-join(
    ("
",
     "variable $contextItemQuery := xqxq:prepare-main-module('",
     env:get-schema-import($env),
     concat('validate { doc("', $ciURI, '")', "}',", " "),
           "resolver:url-resolver#2, ());",
           "variable $contextItem := xqxq:evaluate($contextItemQuery);")
   ,"
")
};

(:~
 : Returns the XQXQ URL resolver declaration.
 : @param $case the test case.
 : @param $env the environment.
 : @param $envBaseURI URI of the environment.
 : @param $testSetBaseURI URI to the test set that defines the test case.
 : @return the XQXQ URL resolver declaration.
 :)
declare function env:resolver(
  $case           as element(fots:test-case),
  $env            as element(fots:environment)?,
  $envBaseURI     as xs:anyURI?,
  $testSetBaseURI as xs:anyURI
) as xs:string?
{
  let $envSchema := $env/fots:schema,
      $tcSchema := $case/fots:environment/fots:schema,
      $schemas := ($envSchema, $tcSchema),
      $modules := $case/fots:module,
      $resources := ($env/fots:resource, $case/fots:environment/fots:schema)
  return
    if (empty($schemas) and empty($modules) and empty($resources))
    then ()
    else string-join(
            ("declare namespace resolver = 'http://www.zorba-xquery.com/modules/xqxq/url-resolver';",
             $env:hof,
            "declare function resolver:url-resolver($namespace as xs:string, $entity as xs:string) {",
            "switch($entity)",
    if (exists($schemas))
    then string-join(("case 'schema'",
                     "  return switch($namespace)",
                    (for $schema in $envSchema
                     return concat("    case '",
                                  data($schema/@uri),
                                   "' return doc('",
                                   resolve-uri($schema/@file, $envBaseURI),
                                   "')"),
                      for $schema in $tcSchema
                      return concat("    case '",
                                   data($schema/@uri),
                                   "' return doc('",
                                   resolve-uri($schema/@file, $testSetBaseURI),
                                   "')")),
                      "    default return ()"),
                      "
")
    else (),
    if (exists($modules))
    then string-join(("case 'module'",
                      "  return switch($namespace)",
                      for $module in $modules
                      return concat("    case '",
                                   data($module/@uri),
                                   "' return unparsed-text('",
                                   resolve-uri($module/@file, $testSetBaseURI),
                                   "') "),
                    "    default return ()"),
                    "
")
    else (),
    if (exists($resources)) then
    string-join(("case ''",
                 "  return switch($namespace)",
                  for $resource in $resources
                  return concat("    case '",
                                 data($resource/@uri),
                                 "' return unparsed-text('",
                                 resolve-uri($resource/@file, $envBaseURI),
                                 "'",
                                 if(exists($resource/@encoding))
                                 then concat (",'",
                                              data($resource/@encoding),
                                              "'")
                                 else (),
                                 ") "),
                 "         default return ()")
                ,"
")
    else ()
    , "default return ()","};"),
    "
")
};

(:~
 : Check if an XQuery version declaration needs to be added.
 :
 : @param $deps the dependencies of the test set and test case.
 : @param $test the Query test.
 : @return the XQuery version declaration.
 :)
declare function env:add-xquery-30(
  $deps as element(fots:dependency)*,
  $test as xs:string
) as xs:string? {
  let $dependencies := string-join(distinct-values(for $dep in $deps
                                                   where $dep[@type="spec"]
                                                   return data($dep/@value)),"")
  return
    if ((contains($dependencies,"XQ30") or contains($dependencies,"XP30")) and
        not(contains($test, "xquery version ")))
    then 'xquery version "3.0";'
    else ()
};

(:~
 : If there is a dependency on XQuery 3.0 and there is at least one HOF
 : function in the test, return the strings for enabling the HOF feature.
 :
 : @param $deps the dependencies of the test set and test case
 : @param $test the Query test.
 : @return the strings for enabling the HOF feature
 :)
declare function env:enable-HOF-feature(
  $deps as element(fots:dependency)*,
  $test as xs:string
) as xs:string? {
  let $depSpec := string-join(distinct-values( for $dep in $deps
                                               where $dep[@type="spec"]
                                               return data($dep/@value)),""),
      $depFeature := string-join(distinct-values(for $dep in $deps
                                                 where $dep[@type="feature"]
                                                 return data($dep/@value)),"")
  return
    if ((contains($depSpec,"XQ30") or contains($depSpec,"XP30")) and
         contains($depFeature,"higherOrderFunctions"))
    then $env:hof else ()
};

(:~
 : Checks the dependencies according to the Zorba manifest.
 :
 : @param $deps the dependencies of the test set and test case
 : @param $zorbaManifest Zorba manifest document.
 : @return if true empty string, otherwise returns a string with the
 : dependencies that were not matched.
 :)
declare function env:check-dependencies(
  $deps           as element(fots:dependency)*,
  $zorbaManifest
) as xs:string* {
  if(empty($deps))
  then ()
  else
    for $dep in $deps
    let $satisfied := if(exists($dep/@satisfied))
                      then data($dep/@satisfied)
                      else "true"
    let $zorbaDep := $zorbaManifest//fots:dependency[ @type = $dep/@type and
                                                      @value = $dep/@value and
                                                      @satisfied = $satisfied]
    return
      if(empty($zorbaDep))
      then concat("Dependency (type=",
                  $dep/@type,
                  ", value=",
                  $dep/@value,
                  ", satisfied=",
                  $satisfied,
                  ") was not met. ")
      else ()
};

declare %private function env:set-properties(
  $decimal-format as element(fots:decimal-format)
) as xs:string* {
  for $att in $decimal-format/attribute::*
  let $name := node-name($att)
  let $value := data($att)
  return
    if(exists(index-of(("decimal-separator", "grouping-separator", "infinity",
                        "minus-sign", "NaN", "percent", "per-mille",
                        "zero-digit", "digit", "pattern-separator"),
                        xs:string($name))))
    then concat($name, '="' , $value, '"')
    else ()
};

(:~
 : Add the decimal format declarations.
 :
 : @param $decimal-formats decimal formats.
 : @return the decimal formats declarations.
 :)
declare function env:decl-decimal-formats(
  $decimal-formats as element(fots:decimal-format)*
) as xs:string* {
  if(empty($decimal-formats))
  then ()
  else
    for $tmp in $decimal-formats
    let $default := if(exists($tmp/@name))
                    then ()
                    else "default"
    let $name :=  if(exists($tmp/@name))
                  then data($tmp/@name)
                  else ()
    return
      string-join(("declare",
                    $default,
                    "decimal-format",
                    $name,
                    env:set-properties($tmp),
                    ";"),' ')
};


relax check for filtering root nodes of org hierarchy

(:~
: This is the Care Services Discovery base XQuery module
: @version 1.0
: @see http://ihe.net
:
:)

module namespace csd = "https://github.com/openhie/openinfoman/csd_bl";
import module namespace functx = "http://www.functx.com";

declare default element  namespace   "urn:ihe:iti:csd:2013";

(:Utility methods:)
declare function csd:wrap_providers($providers)
{
<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory/>
  <serviceDirectory/>
  <facilityDirectory/>
  <providerDirectory>
  {$providers}
  </providerDirectory>
</CSD>

};

declare function csd:wrap_organizations($organizations)
{
<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory>
  {$organizations}
  </organizationDirectory>
  <serviceDirectory/>
  <facilityDirectory/>
  <providerDirectory/>
</CSD>

};

declare function csd:wrap_facilities($facilities)
{
<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory/>
  <serviceDirectory/>
  <facilityDirectory>
  {$facilities}
  </facilityDirectory>
  <providerDirectory/>
</CSD>

};

declare function csd:wrap_services($services)
{
<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory/>
  <serviceDirectory>
    {$services}
  </serviceDirectory>
  <facilityDirectory/>
  <providerDirectory/>
</CSD>

};

(:~
 :Generate UUID as OID according to http://www.itu.int/ITU-T/asn1/uuid.html
 :)
declare function csd:uuid_as_oid() {
  let $zero := convert:binary-to-bytes('0')
  let $nine := convert:binary-to-bytes('9')
  let $a := convert:binary-to-bytes('A')
  let $e := convert:binary-to-bytes('E')
  let $uuid := convert:binary-to-bytes(upper-case(translate(random:uuid(),'-','')))
  let $uuid_dec := $uuid
    ! xs:decimal(if ( (. >= $zero and . <= $nine)) then (.  - $zero) else if ( (. >= $a and . <= $e)) then (. - $a + 10) else ())
  return concat('2.25.',   fold-left($uuid_dec, 0, function($a, $b) { $a * 16 + $b }) )
};

(:~
 : this function accepts a list of items to filter by address
 :
 : @param $items - a list of items to filter by their <address/> child elements
 : @param $components - a list of address component values.  Each item should have an @component attribute indicating the component type. The text content is the component value.
 : @return all items in $items which have address/addressLine which matches exactly (case insensitive) on each of the given components.
 : @since 1.0
 :
:)
declare function csd:filter_by_address($items as item()*,$components as item()*) as item()*
{
    if (count($components) = 0
       or not ($components[1]/@component)
       or not ($components[1]/text())
    )
    then  $items
    else
           let $comp := $components[1]/@component
           let $val := fn:upper-case($components[1]/text())
           return csd:filter_by_address(
	     $items[address/addressLine[@component = $comp and fn:upper-case(text()) = $val]],
	     fn:subsequence($components,2))
};

(:~
 : this function accepts a list of items to filter by address
 :
 : @param $items - a list of items to filter by their <address/> child elements
 : @param $components - a list of address component values.  Each item should have an @component attribute indicating the component type. The text content is the component value.
 : @return all items in $items which have address/addressLine which matches exactly (case insensitive) on each of the given components.
 : @since 1.0
 :
:)
declare function csd:filter_by_demographic_address($items as item()*,$components as item()*) as item()*
{
    if (count($components) = 0
       or not ($components[1]/@component)
       or not ($components[1]/text())
    )
    then  $items
    else
           let $comp := $components[1]/@component
           let $val := fn:upper-case($components[1]/text())
           return csd:filter_by_address(
	     $items[demographic/address/addressLine[@component = $comp and fn:upper-case(text()) = $val]],
	     fn:subsequence($components,2))
};

(:~
 : this function accepts a list of items to filter by type
 :
 : @param $items - a list of items to filter by their <codedType/> child elements
 : @param $codedtype - a coded type, if specified, to filter the $items list by type.  A @code attribute, if present, results in selecting those $items with matching codedType/@code (case-insensitive) exactly.  Text content, if present,  results in selecting the $items whose codedType/text() contains that value (case-insensitive) with the given @codingScheme (case-insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_coded_type($items as item()*, $codedtype as item()) as item()*
{
     if (exists($codedtype/@code) and exists($codedtype/@codingScheme))
     then
        let $code := fn:upper-case($codedtype/@code)
	    let $cScheme := $codedtype/@codingScheme
        return $items[codedType[
                @code = $code
 	            and
                @codingScheme = $cScheme
                ]
            ]
     else $items
};

(:~
 : this function accepts a list of items to filter by their primary name
 :
 : @param $items - a list of items to filter by their <primaryName/> child elements
 : @param $primaryName - a name, if specified, to filter the $items list by their <primaryName/> child elements.  The text content of $primaryName, if present, results in selecting those $items containing that content. Case-insenisitive.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_primary_name($items as item()*,$primaryName as item()) as item()*
{
  let $u_primaryName := fn:upper-case($primaryName/text())
  return
    if (not(functx:all-whitespace($u_primaryName)))
      (: then $items[contains(fn:upper-case(./primaryName) , $u_primaryName)] :)
    then $items[upper-case(./primaryName) = $u_primaryName]
    else $items
};

(:~
 : this function accepts a list of items to filter by their primary name or other name
 :
 : @param $items - a list of items to filter by their <primaryName/> and <otherName/> child elements
 : @param $name - a name, if specified, to filter the $items list by either their <primaryName/> or <otherName/> child elements .  The text content of $name, if present, results in selecting those $items containing that content. Case-insenisitive.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_name($items as item()*,$name as item()) as item()*
{
  if (not($name = ''))
    then
    let $u_name:= fn:upper-case($name)
    for $item in $items
      let $matches0:=
        for $name in $item/otherName
	return if (contains(upper-case($name),$u_name)) then ($name) else ()
      let $matches1 := ($matches0, $item[contains(upper-case(primaryName),$u_name)])
      where  count($matches1) > 0
     return $item
  else $items
};

(:~
 : this function accepts a list of items to filter by their primary id
 :
 : @param $items - a list of items to filter by their primary id
 : @param $id - a uniqueID, if present with an non-empty @urn attribute then it is used to filter the $items list by their @entityID attributes by performing an exact match of the @entityID $id.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_primary_id($items as item()*,$id as item()) as item()*
{
       if ($id/@entityID)
       then
         let $entityID := upper-case($id/@entityID)
         return $items[upper-case(@entityID) =$entityID]
       else $items
};

(:~
 : this function accepts a list of items to filter by their  by their <otherId/> child elements
 :
 : @param $items - a list of items to filter by their id
 : @param $id - an otherIDI, if specified, to filter the $items list by their @code and @assigningAuthorityName attributes any child <otherID> elements by performing an exact, case-insensitive match of the @code and @assigningAuthorityName attributes of $id.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_other_id($items as item()*,$id as item()) as item()*
{
       if (exists($id))
       then
           let $aaName := fn:upper-case($id/@assigningAuthorityName	)
           let $code := fn:upper-case($id/@code)
	   let $val := fn:upper-case($id/text())
           return
	     if (not(functx:all-whitespace($aaName)) and not(functx:all-whitespace($code)) and not(functx:all-whitespace($id))) then
	       $items[
                 otherID[
                 fn:upper-case(@assigningAuthorityName)=$aaName
                 and fn:upper-case(@code)=$code
		 and fn:upper-case(./text()) = $val
                 ]]
	     else if (not(functx:all-whitespace($aaName)) and not(functx:all-whitespace($val))) then
	       (:if we are here, we know that $code is blank :)
	       $items[
                 otherID[
                 fn:upper-case(@assigningAuthorityName)=$aaName
		 and fn:upper-case(./text()) = $val
                 ]]
	     else if (not(functx:all-whitespace($aaName)) and not(functx:all-whitespace($code))) then
	       (:if we are here, we know that $val is blank :)
	       $items[
                 otherID[
                 fn:upper-case(@assigningAuthorityName)=$aaName
		 and fn:upper-case(@code)=$code
                 ]]
	     else if (not(functx:all-whitespace($val)) and not(functx:all-whitespace($code))) then
	       (:if we are here, we know that $aaName is blank :)
	       $items[
                 otherID[
	       	 fn:upper-case(./text()) = $val
		 and fn:upper-case(@code)=$code
                 ]]
	     else if (not(functx:all-whitespace($val))) then
	       (:if we are here, we know that $val is only non-blank :)
	       $items[  otherID[ fn:upper-case(./text()) = $val]]
	     else if (not(functx:all-whitespace($code))) then
	       (:if we are here, we know that $code is only non-blank :)
	       $items[  otherID[ fn:upper-case(@code)=$code]]
	     else if (not(functx:all-whitespace($aaName))) then
	       (:if we are here, we know that $aaName is only non-blank :)
	       $items[  otherID[ fn:upper-case(@assigningAuthorityName)=$aaName]]
	     else $items (:it's all blank so don't filter:)
        else $items
};

(:~
 : this function accepts a list of items to filter by their common name
 :
 : @param $items - a list of items to filter by their common name
 : @param $name - an xs:string, if specified, to filter the $items list selecting those whose child demographic/name/commonName child-element whose text content contains the text content of $name (case insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_common_name($items as item()*, $name as item()) as item()*
{
       if (not($name = ''))
	 then
	 let $u_name:= fn:upper-case($name)
	 for $item in $items
	 let $matches:=
	   for $name in $item/demographic/name/commonName
	     return if (contains(upper-case($name),$u_name)) then ($name) else ()
	 where count($matches) > 0
	 return $item
       else $items
};

(:~
 : this function accepts a list of items to filter by their surname
 :
 : @param $items - a list of items to filter by their surname
 : @param $name - an xs:string, if specified, to filter the $items list selecting those whose child demographic/name/surname child-element whose text content contains the text content of $name (case insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_surname($items as item()*, $name as item()) as item()*
{
       if (not($name = ''))
       then
	 let $u_name:= fn:upper-case($name)
	 for $item in $items
	 let $matches:=
	   for $name in $item/demographic/name/surname
	     return if (contains(upper-case($name),$u_name)) then ($name) else ()
	 where count($matches) > 0
	 return $item
       else $items
};

(:~
 : this function accepts a list of items to filter by the start of their surname
 :
 : @param $items - a list of items to filter by their surname
 : @param $name - an xs:string, if specified, to filter the $items list selecting those whose child demographic/name/surname child-element whose text content starts with the text content of $name (case insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_surname_starts_with($items as item()*, $name as item()) as item()*
{
       if (not($name = ''))
       then
	 let $u_name:= fn:upper-case($name)
	 for $item in $items
	 let $matches:=
	   for $name in $item/demographic/name/surname
	     return if (starts-with(upper-case($name),$u_name)) then ($name) else ()
	 where count($matches) > 0
	 return $item
       else $items
};

(:~
 : this function accepts a list of items to filter by their forename
 :
 : @param $items - a list of items to filter by their forename
 : @param $name - an xs:string, if specified, to filter the $items list selecting those whose child demographic/name/forename child-element whose text content contains the text content of $name (case insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_forename($items as item()*, $name as item()) as item()*
{
       if (not($name = ''))
       then
	 let $u_name:= fn:upper-case($name)
	 for $item in $items
	 let $matches:=
	   for $name in $item/demographic/name/forename
	     return if (contains(upper-case($name),$u_name)) then ($name) else ()
	 where count($matches) > 0
	 return $item
       else $items
};

(:~
 : this function accepts a list of items to filter by the start of their forename
 :
 : @param $items - a list of items to filter by their forename
 : @param $name - an xs:string, if specified, to filter the $items list selecting those whose child demographic/name/forename child-element whose text content starts with the text content of $name (case insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_forename_starts_with($items as item()*, $name as item()) as item()*
{
       if (not($name =''))
       then
	 let $u_name:= fn:upper-case($name)
	 for $item in $items
	 let $matches:=
	   for $name in $item/demographic/name/forename
	     return if (starts-with(upper-case($name),$u_name)) then ($name) else ()
	 where count($matches) > 0
	 return $item
       else $items
};

(:~
 : this function accepts a list of items to filter by their record details
 :
 : @param $items - a list of items to filter by their record details
 : @param $record - a csd:record, if specified, to filter the $items list selecting those whose child record/@status matches $record/@status exactly (case insensitive) if $record/@status is presnet non-empty and record/@updated is at least $record/@updated if the later is present and non-empty
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_record($items as item()*, $record as item()) as item()*
{
    let $items1:=
        if (not($record/@status) )
        then $items
        else
             let $status:= $record/@status
             return $items[record/@status = $status]
    return
        if (not($record/@updated) )
        then $items1
        else $items1[record/@updated >= $record/@updated ]

};

(:~
 : this function accepts a list of items to limit to a subset
 :
 : @param $items - a list of items to limit
 : @param $start - a start index for limiting the item list.  If not specified then defaults to 1
 : @param $max - a maximum number of results to return.  If negattive or not specified returns all restults.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:limit_items($items as item()*, $start as item(),$max as item()) as item()*
{
        if (not(fn:number($start)) or xs:integer($start) < 1)
        then if (not(fn:number($max)) or xs:integer($max) < 0)
            then $items
            else $items[position() <= xs:integer($max)]
        else if (fn:number($max) and xs:integer($max) >= 0)
        then $items[position() >= xs:integer($start) and position() < (xs:integer($start) + xs:integer($max))]
        else $items[position() >= xs:integer($start)]

 };

(:~
 : filters by the parent entities (applicable only to oragnization)
 :
 : @param $items - a list of items to filter by their record details
 : @param $orgs - a list of organizations that to filter $items against.  A member of $items is kept if there is at least one member of $orgs to which it is associated to
 : @return all items in $items which match as above
 : @since 1.0
 :
:)

declare function csd:filter_by_parent($items as item()*,$parent as item()*) as item()*
{
  let $entityID:= upper-case($parent/@entityID)
  return
    if (not(exists($entityID)))
    then $items
    else if (functx:all-whitespace($parent/@entityID))
    then $items[not(./parent) or functx:all-whitespace(./parent/@entityID) ]
    else $items[./parent[upper-case(@entityID) = $entityID]]
};

(:~
 : this function accepts a list of items to filter against a list of organizations
 :
 : @param $items - a list of items to filter by their record details
 : @param $orgs - a list of organizations that to filter $items against.  A member of $items is kept if there is at least one member of $orgs to which it is associated to
 : @return all items in $items which match as above
 : @since 1.0
 :
:)

declare function csd:filter_by_organizations($items as item()*,$orgs as item()*) as item()*
{
    if (count($orgs) = 0
       or not ($orgs[1]/@entityID)
    )
    then  $items
    else
           let $org := upper-case($orgs[1]/@entityID)
           return csd:filter_by_organizations(
	     $items[organizations/organization[upper-case(@entityID) = $org]],
	     fn:subsequence($orgs,2))

};

declare function csd:filter_by_languages($items as item()*,$langs as item()*) as item()*
{
    if (count($langs) = 0
       or (not ($langs[1]/@code) )
       or (not ($langs[1]/@codingScheme))
       )
    then $items
    else
           let $code := upper-case($langs[1]/@code)
           let $codingScheme := upper-case($langs[1]/@codingScheme)
           return csd:filter_by_languages(
	     $items[./language[upper-case(@code) = $code and upper-case(@codingScheme) = $codingScheme]],
	     fn:subsequence($langs,2))

};

(:~
 : this function accepts a list of items to filter against a list of facilities
 :
 : @param $items - a list of items to filter by their record details
 : @param $orgs - a list of facilities that to filter $items against.  A member of $items is kept if there is at least one member of $facs to which it is associated to
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_facilities($items as item()*,$facs as item()*) as item()*
{
    if (count($facs) = 0
       or not ($facs[1]/@entityID)
    )
    then  $items
    else
           let $fac := upper-case($facs[1]/@entityID)
           return csd:filter_by_facilities(
	     $items[facilities/facility[upper-case(@entityID) = $fac]],
	     fn:subsequence($facs,2))
};

(:~
 : this function accepts a list of organizations and augments it to invclude all (grand-)*child organizations that are present within the given organization directory
 : @param $orgs - a list of organizations
 : @param $orgdir - the organization directory we are looking within to find (grand-)*child organizations
 : @return all organizations of $orgdir which are (grand-)*child organization of the list or given organizations $orgs. includes $orgs.
:)
declare function csd:join_child_organizations($orgs as item()*,$orgdir as item()) as item()*
{
     if (count($orgs) = 0)
     then ()
     else
        csd:get_child_organizations($orgs[1],$orgdir)
        union
        csd:join_child_organizations(fn:subsequence($orgs,2),$orgdir)
};

(:~
 : this function returns a list of all (grand-)*child organizations of a given organization with the given organization directory
 : @param $org - an organization
 : @param $orgdir - the organization directory we are looking within to find (grand-)*child organizations
 : @return all organizations of $orgdir which are (grand-)*child organization of the list or given organization $org. includes $org.
:)
declare function csd:get_child_organizations($org as item(),$orgdir as item()) as item()*
{
    if (not($org))
    then ()
    else
       let $root := fn:upper-case($org/@root)
       let $extension := fn:upper-case($org/@extension)
       let $child_orgs := $orgdir/organization[
                               fn:upper-case(parent/@root)=$root
                               and fn:upper-case(parent/@extension)=$extension
                               ]
       return ($org,csd:join_child_organizations($child_orgs,$orgdir))
};

(:~
 : this function returns a list of all (grand-)*parent organizations of a given organization with the given organization directory
 : @param $org - an organization
 : @param $orgdir - the organization directory we are looking within to find (grand-)*parent organizations
 : @return all organizations of $orgdir which are (grand-)*parent organization of the list or given organization $org. includes $org.
:)
declare function csd:get_parent_organizations($org as item(),$orgdir as item()) as item()*
{
    if (not($org/parent/@root))
    then $org
    else
       let $root := fn:upper-case($org/parent/@root)
       let $extension := fn:upper-case($org/parent/@extension)
       return (
                $org ,
               csd:get_parent_organizations(
                    $orgdir/organization[
                        fn:upper-case(@root)=$root and fn:upper-case(@extension)=$extension
                        ],
                    $orgdir
                    )
               )
};

(:~
 : this function accepts a list of organizations and augments it to invclude all (grand-)*parent organizations that are present within the given organization directory
 : @param $orgs - a list of organizations
 : @param $orgdir - the organization directory we are looking within to find (grand-)*parent organizations
 : @return all organizations of $orgdir which are (grand-)*parent organization of the list or given organizations $orgs. includes $orgs.
:)
declare function csd:join_parent_organizations($orgs as item()*,$orgdir as item()) as item()*
{
     if (count($orgs) = 0)
     then ()
     else
        csd:get_parent_organizations($orgs[1],$orgdir)
        union
        csd:join_parent_organizations(fn:subsequence($orgs,2),$orgdir)
};

(:~
: This is the Care Services Discovery base XQuery module
: @version 1.0
: @see http://ihe.net
:
:)

module namespace csd = "https://github.com/openhie/openinfoman/csd_bl";
import module namespace functx = "http://www.functx.com";

declare default element  namespace   "urn:ihe:iti:csd:2013";

(:Utility methods:)
declare function csd:wrap_providers($providers)
{
<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory/>
  <serviceDirectory/>
  <facilityDirectory/>
  <providerDirectory>
  {$providers}
  </providerDirectory>
</CSD>

};

declare function csd:wrap_organizations($organizations)
{
<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory>
  {$organizations}
  </organizationDirectory>
  <serviceDirectory/>
  <facilityDirectory/>
  <providerDirectory/>
</CSD>

};

declare function csd:wrap_facilities($facilities)
{
<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory/>
  <serviceDirectory/>
  <facilityDirectory>
  {$facilities}
  </facilityDirectory>
  <providerDirectory/>
</CSD>

};

declare function csd:wrap_services($services)
{
<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory/>
  <serviceDirectory>
    {$services}
  </serviceDirectory>
  <facilityDirectory/>
  <providerDirectory/>
</CSD>

};

(:~
 :Generate UUID as OID according to http://www.itu.int/ITU-T/asn1/uuid.html
 :)
declare function csd:uuid_as_oid() {
  let $zero := convert:binary-to-bytes('0')
  let $nine := convert:binary-to-bytes('9')
  let $a := convert:binary-to-bytes('A')
  let $e := convert:binary-to-bytes('E')
  let $uuid := convert:binary-to-bytes(upper-case(translate(random:uuid(),'-','')))
  let $uuid_dec := $uuid
    ! xs:decimal(if ( (. >= $zero and . <= $nine)) then (.  - $zero) else if ( (. >= $a and . <= $e)) then (. - $a + 10) else ())
  return concat('2.25.',   fold-left($uuid_dec, 0, function($a, $b) { $a * 16 + $b }) )
};

(:~
 : this function accepts a list of items to filter by address
 :
 : @param $items - a list of items to filter by their <address/> child elements
 : @param $components - a list of address component values.  Each item should have an @component attribute indicating the component type. The text content is the component value.
 : @return all items in $items which have address/addressLine which matches exactly (case insensitive) on each of the given components.
 : @since 1.0
 :
:)
declare function csd:filter_by_address($items as item()*,$components as item()*) as item()*
{
    if (count($components) = 0
       or not ($components[1]/@component)
       or not ($components[1]/text())
    )
    then  $items
    else
           let $comp := $components[1]/@component
           let $val := fn:upper-case($components[1]/text())
           return csd:filter_by_address(
	     $items[address/addressLine[@component = $comp and fn:upper-case(text()) = $val]],
	     fn:subsequence($components,2))
};

(:~
 : this function accepts a list of items to filter by address
 :
 : @param $items - a list of items to filter by their <address/> child elements
 : @param $components - a list of address component values.  Each item should have an @component attribute indicating the component type. The text content is the component value.
 : @return all items in $items which have address/addressLine which matches exactly (case insensitive) on each of the given components.
 : @since 1.0
 :
:)
declare function csd:filter_by_demographic_address($items as item()*,$components as item()*) as item()*
{
    if (count($components) = 0
       or not ($components[1]/@component)
       or not ($components[1]/text())
    )
    then  $items
    else
           let $comp := $components[1]/@component
           let $val := fn:upper-case($components[1]/text())
           return csd:filter_by_address(
	     $items[demographic/address/addressLine[@component = $comp and fn:upper-case(text()) = $val]],
	     fn:subsequence($components,2))
};

(:~
 : this function accepts a list of items to filter by type
 :
 : @param $items - a list of items to filter by their <codedType/> child elements
 : @param $codedtype - a coded type, if specified, to filter the $items list by type.  A @code attribute, if present, results in selecting those $items with matching codedType/@code (case-insensitive) exactly.  Text content, if present,  results in selecting the $items whose codedType/text() contains that value (case-insensitive) with the given @codingScheme (case-insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_coded_type($items as item()*, $codedtype as item()) as item()*
{
     if (exists($codedtype/@code) and exists($codedtype/@codingScheme))
     then
        let $code := fn:upper-case($codedtype/@code)
	    let $cScheme := $codedtype/@codingScheme
        return $items[codedType[
                @code = $code
 	            and
                @codingScheme = $cScheme
                ]
            ]
     else $items
};

(:~
 : this function accepts a list of items to filter by their primary name
 :
 : @param $items - a list of items to filter by their <primaryName/> child elements
 : @param $primaryName - a name, if specified, to filter the $items list by their <primaryName/> child elements.  The text content of $primaryName, if present, results in selecting those $items containing that content. Case-insenisitive.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_primary_name($items as item()*,$primaryName as item()) as item()*
{
  let $u_primaryName := fn:upper-case($primaryName/text())
  return
    if (not(functx:all-whitespace($u_primaryName)))
      (: then $items[contains(fn:upper-case(./primaryName) , $u_primaryName)] :)
    then $items[upper-case(./primaryName) = $u_primaryName]
    else $items
};

(:~
 : this function accepts a list of items to filter by their primary name or other name
 :
 : @param $items - a list of items to filter by their <primaryName/> and <otherName/> child elements
 : @param $name - a name, if specified, to filter the $items list by either their <primaryName/> or <otherName/> child elements .  The text content of $name, if present, results in selecting those $items containing that content. Case-insenisitive.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_name($items as item()*,$name as item()) as item()*
{
  if (not($name = ''))
    then
    let $u_name:= fn:upper-case($name)
    for $item in $items
      let $matches0:=
        for $name in $item/otherName
	return if (contains(upper-case($name),$u_name)) then ($name) else ()
      let $matches1 := ($matches0, $item[contains(upper-case(primaryName),$u_name)])
      where  count($matches1) > 0
     return $item
  else $items
};

(:~
 : this function accepts a list of items to filter by their primary id
 :
 : @param $items - a list of items to filter by their primary id
 : @param $id - a uniqueID, if present with an non-empty @urn attribute then it is used to filter the $items list by their @entityID attributes by performing an exact match of the @entityID $id.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_primary_id($items as item()*,$id as item()) as item()*
{
       if ($id/@entityID)
       then
         let $entityID := upper-case($id/@entityID)
         return $items[upper-case(@entityID) =$entityID]
       else $items
};

(:~
 : this function accepts a list of items to filter by their  by their <otherId/> child elements
 :
 : @param $items - a list of items to filter by their id
 : @param $id - an otherIDI, if specified, to filter the $items list by their @code and @assigningAuthorityName attributes any child <otherID> elements by performing an exact, case-insensitive match of the @code and @assigningAuthorityName attributes of $id.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_other_id($items as item()*,$id as item()) as item()*
{
       if (exists($id))
       then
           let $aaName := fn:upper-case($id/@assigningAuthorityName	)
           let $code := fn:upper-case($id/@code)
	   let $val := fn:upper-case($id/text())
           return
	     if (not(functx:all-whitespace($aaName)) and not(functx:all-whitespace($code)) and not(functx:all-whitespace($id))) then
	       $items[
                 otherID[
                 fn:upper-case(@assigningAuthorityName)=$aaName
                 and fn:upper-case(@code)=$code
		 and fn:upper-case(./text()) = $val
                 ]]
	     else if (not(functx:all-whitespace($aaName)) and not(functx:all-whitespace($val))) then
	       (:if we are here, we know that $code is blank :)
	       $items[
                 otherID[
                 fn:upper-case(@assigningAuthorityName)=$aaName
		 and fn:upper-case(./text()) = $val
                 ]]
	     else if (not(functx:all-whitespace($aaName)) and not(functx:all-whitespace($code))) then
	       (:if we are here, we know that $val is blank :)
	       $items[
                 otherID[
                 fn:upper-case(@assigningAuthorityName)=$aaName
		 and fn:upper-case(@code)=$code
                 ]]
	     else if (not(functx:all-whitespace($val)) and not(functx:all-whitespace($code))) then
	       (:if we are here, we know that $aaName is blank :)
	       $items[
                 otherID[
	       	 fn:upper-case(./text()) = $val
		 and fn:upper-case(@code)=$code
                 ]]
	     else if (not(functx:all-whitespace($val))) then
	       (:if we are here, we know that $val is only non-blank :)
	       $items[  otherID[ fn:upper-case(./text()) = $val]]
	     else if (not(functx:all-whitespace($code))) then
	       (:if we are here, we know that $code is only non-blank :)
	       $items[  otherID[ fn:upper-case(@code)=$code]]
	     else if (not(functx:all-whitespace($aaName))) then
	       (:if we are here, we know that $aaName is only non-blank :)
	       $items[  otherID[ fn:upper-case(@assigningAuthorityName)=$aaName]]
	     else $items (:it's all blank so don't filter:)
        else $items
};

(:~
 : this function accepts a list of items to filter by their common name
 :
 : @param $items - a list of items to filter by their common name
 : @param $name - an xs:string, if specified, to filter the $items list selecting those whose child demographic/name/commonName child-element whose text content contains the text content of $name (case insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_common_name($items as item()*, $name as item()) as item()*
{
       if (not($name = ''))
	 then
	 let $u_name:= fn:upper-case($name)
	 for $item in $items
	 let $matches:=
	   for $name in $item/demographic/name/commonName
	     return if (contains(upper-case($name),$u_name)) then ($name) else ()
	 where count($matches) > 0
	 return $item
       else $items
};

(:~
 : this function accepts a list of items to filter by their surname
 :
 : @param $items - a list of items to filter by their surname
 : @param $name - an xs:string, if specified, to filter the $items list selecting those whose child demographic/name/surname child-element whose text content contains the text content of $name (case insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_surname($items as item()*, $name as item()) as item()*
{
       if (not($name = ''))
       then
	 let $u_name:= fn:upper-case($name)
	 for $item in $items
	 let $matches:=
	   for $name in $item/demographic/name/surname
	     return if (contains(upper-case($name),$u_name)) then ($name) else ()
	 where count($matches) > 0
	 return $item
       else $items
};

(:~
 : this function accepts a list of items to filter by the start of their surname
 :
 : @param $items - a list of items to filter by their surname
 : @param $name - an xs:string, if specified, to filter the $items list selecting those whose child demographic/name/surname child-element whose text content starts with the text content of $name (case insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_surname_starts_with($items as item()*, $name as item()) as item()*
{
       if (not($name = ''))
       then
	 let $u_name:= fn:upper-case($name)
	 for $item in $items
	 let $matches:=
	   for $name in $item/demographic/name/surname
	     return if (starts-with(upper-case($name),$u_name)) then ($name) else ()
	 where count($matches) > 0
	 return $item
       else $items
};

(:~
 : this function accepts a list of items to filter by their forename
 :
 : @param $items - a list of items to filter by their forename
 : @param $name - an xs:string, if specified, to filter the $items list selecting those whose child demographic/name/forename child-element whose text content contains the text content of $name (case insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_forename($items as item()*, $name as item()) as item()*
{
       if (not($name = ''))
       then
	 let $u_name:= fn:upper-case($name)
	 for $item in $items
	 let $matches:=
	   for $name in $item/demographic/name/forename
	     return if (contains(upper-case($name),$u_name)) then ($name) else ()
	 where count($matches) > 0
	 return $item
       else $items
};

(:~
 : this function accepts a list of items to filter by the start of their forename
 :
 : @param $items - a list of items to filter by their forename
 : @param $name - an xs:string, if specified, to filter the $items list selecting those whose child demographic/name/forename child-element whose text content starts with the text content of $name (case insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_forename_starts_with($items as item()*, $name as item()) as item()*
{
       if (not($name =''))
       then
	 let $u_name:= fn:upper-case($name)
	 for $item in $items
	 let $matches:=
	   for $name in $item/demographic/name/forename
	     return if (starts-with(upper-case($name),$u_name)) then ($name) else ()
	 where count($matches) > 0
	 return $item
       else $items
};

(:~
 : this function accepts a list of items to filter by their record details
 :
 : @param $items - a list of items to filter by their record details
 : @param $record - a csd:record, if specified, to filter the $items list selecting those whose child record/@status matches $record/@status exactly (case insensitive) if $record/@status is presnet non-empty and record/@updated is at least $record/@updated if the later is present and non-empty
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_record($items as item()*, $record as item()) as item()*
{
    let $items1:=
        if (not($record/@status) )
        then $items
        else
             let $status:= $record/@status
             return $items[record/@status = $status]
    return
        if (not($record/@updated) )
        then $items1
        else $items1[record/@updated >= $record/@updated ]

};

(:~
 : this function accepts a list of items to limit to a subset
 :
 : @param $items - a list of items to limit
 : @param $start - a start index for limiting the item list.  If not specified then defaults to 1
 : @param $max - a maximum number of results to return.  If negattive or not specified returns all restults.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:limit_items($items as item()*, $start as item(),$max as item()) as item()*
{
        if (not(fn:number($start)) or xs:integer($start) < 1)
        then if (not(fn:number($max)) or xs:integer($max) < 0)
            then $items
            else $items[position() <= xs:integer($max)]
        else if (fn:number($max) and xs:integer($max) >= 0)
        then $items[position() >= xs:integer($start) and position() < (xs:integer($start) + xs:integer($max))]
        else $items[position() >= xs:integer($start)]

 };

(:~
 : filters by the parent entities (applicable only to oragnization)
 :
 : @param $items - a list of items to filter by their record details
 : @param $orgs - a list of organizations that to filter $items against.  A member of $items is kept if there is at least one member of $orgs to which it is associated to
 : @return all items in $items which match as above
 : @since 1.0
 :
:)

declare function csd:filter_by_parent($items as item()*,$parent as item()*) as item()*
{
  let $entityID:= upper-case($parent/@entityID)
  return
    if (not(exists($entityID)))
    then $items
    else if (functx:all-whitespace($parent/@entityID))
    then $items[not(./parent)]
    else $items[./parent[upper-case(@entityID) = $entityID]]
};

(:~
 : this function accepts a list of items to filter against a list of organizations
 :
 : @param $items - a list of items to filter by their record details
 : @param $orgs - a list of organizations that to filter $items against.  A member of $items is kept if there is at least one member of $orgs to which it is associated to
 : @return all items in $items which match as above
 : @since 1.0
 :
:)

declare function csd:filter_by_organizations($items as item()*,$orgs as item()*) as item()*
{
    if (count($orgs) = 0
       or not ($orgs[1]/@entityID)
    )
    then  $items
    else
           let $org := upper-case($orgs[1]/@entityID)
           return csd:filter_by_organizations(
	     $items[organizations/organization[upper-case(@entityID) = $org]],
	     fn:subsequence($orgs,2))

};

declare function csd:filter_by_languages($items as item()*,$langs as item()*) as item()*
{
    if (count($langs) = 0
       or (not ($langs[1]/@code) )
       or (not ($langs[1]/@codingScheme))
       )
    then $items
    else
           let $code := upper-case($langs[1]/@code)
           let $codingScheme := upper-case($langs[1]/@codingScheme)
           return csd:filter_by_languages(
	     $items[./language[upper-case(@code) = $code and upper-case(@codingScheme) = $codingScheme]],
	     fn:subsequence($langs,2))

};

(:~
 : this function accepts a list of items to filter against a list of facilities
 :
 : @param $items - a list of items to filter by their record details
 : @param $orgs - a list of facilities that to filter $items against.  A member of $items is kept if there is at least one member of $facs to which it is associated to
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_facilities($items as item()*,$facs as item()*) as item()*
{
    if (count($facs) = 0
       or not ($facs[1]/@entityID)
    )
    then  $items
    else
           let $fac := upper-case($facs[1]/@entityID)
           return csd:filter_by_facilities(
	     $items[facilities/facility[upper-case(@entityID) = $fac]],
	     fn:subsequence($facs,2))
};

(:~
 : this function accepts a list of organizations and augments it to invclude all (grand-)*child organizations that are present within the given organization directory
 : @param $orgs - a list of organizations
 : @param $orgdir - the organization directory we are looking within to find (grand-)*child organizations
 : @return all organizations of $orgdir which are (grand-)*child organization of the list or given organizations $orgs. includes $orgs.
:)
declare function csd:join_child_organizations($orgs as item()*,$orgdir as item()) as item()*
{
     if (count($orgs) = 0)
     then ()
     else
        csd:get_child_organizations($orgs[1],$orgdir)
        union
        csd:join_child_organizations(fn:subsequence($orgs,2),$orgdir)
};

(:~
 : this function returns a list of all (grand-)*child organizations of a given organization with the given organization directory
 : @param $org - an organization
 : @param $orgdir - the organization directory we are looking within to find (grand-)*child organizations
 : @return all organizations of $orgdir which are (grand-)*child organization of the list or given organization $org. includes $org.
:)
declare function csd:get_child_organizations($org as item(),$orgdir as item()) as item()*
{
    if (not($org))
    then ()
    else
       let $root := fn:upper-case($org/@root)
       let $extension := fn:upper-case($org/@extension)
       let $child_orgs := $orgdir/organization[
                               fn:upper-case(parent/@root)=$root
                               and fn:upper-case(parent/@extension)=$extension
                               ]
       return ($org,csd:join_child_organizations($child_orgs,$orgdir))
};

(:~
 : this function returns a list of all (grand-)*parent organizations of a given organization with the given organization directory
 : @param $org - an organization
 : @param $orgdir - the organization directory we are looking within to find (grand-)*parent organizations
 : @return all organizations of $orgdir which are (grand-)*parent organization of the list or given organization $org. includes $org.
:)
declare function csd:get_parent_organizations($org as item(),$orgdir as item()) as item()*
{
    if (not($org/parent/@root))
    then $org
    else
       let $root := fn:upper-case($org/parent/@root)
       let $extension := fn:upper-case($org/parent/@extension)
       return (
                $org ,
               csd:get_parent_organizations(
                    $orgdir/organization[
                        fn:upper-case(@root)=$root and fn:upper-case(@extension)=$extension
                        ],
                    $orgdir
                    )
               )
};

(:~
 : this function accepts a list of organizations and augments it to invclude all (grand-)*parent organizations that are present within the given organization directory
 : @param $orgs - a list of organizations
 : @param $orgdir - the organization directory we are looking within to find (grand-)*parent organizations
 : @return all organizations of $orgdir which are (grand-)*parent organization of the list or given organizations $orgs. includes $orgs.
:)
declare function csd:join_parent_organizations($orgs as item()*,$orgdir as item()) as item()*
{
     if (count($orgs) = 0)
     then ()
     else
        csd:get_parent_organizations($orgs[1],$orgdir)
        union
        csd:join_parent_organizations(fn:subsequence($orgs,2),$orgdir)
};