Removing liberia namespace as its not yet used

import module namespace csd_bl = "https://github.com/openhie/openinfoman/csd_bl";
declare default element  namespace   "urn:ihe:iti:csd:2013";
declare variable $careServicesRequest as item() external;

(:
   The query will be executed against the root element of the CSD document.

   The dynamic context of this query has $careServicesRequest set to contain any of the search
   and limit paramaters as sent by the Service Finder
:)

<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory/>
  <serviceDirectory/>
  <facilityDirectory/>
  <providerDirectory>
    {

      let $provs0 := if (exists($careServicesRequest/id))
	then csd_bl:filter_by_primary_id(/CSD/providerDirectory/*,$careServicesRequest/id)
      else /CSD/providerDirectory/*

      let $provs1 := if(exists($careServicesRequest/otherID))
	then csd_bl:filter_by_other_id($provs0,$careServicesRequest/otherID)
      else $provs0

      let $provs2 := if(exists($careServicesRequest/commonName))
	then csd_bl:filter_by_common_name($provs1,$careServicesRequest/commonName)
      else $provs1

      let $provs3 := if (exists($careServicesRequest/codedType))
	then csd_bl:filter_by_coded_type($provs2,$careServicesRequest/codedType)
      else $provs2

      let $provs4 := if (exists($careServicesRequest/address/addressLine))
	then csd_bl:filter_by_demographic_address($provs3, $careServicesRequest/address/addressLine)
      else $provs3

      let $provs5 :=  if (exists($careServicesRequest/record))
	then csd_bl:filter_by_record($provs4,$careServicesRequest/record)
      else  $provs4

      let $provs6 :=  if (exists($careServicesRequest/facilities/facility))
	then csd_bl:filter_by_facilities($provs5,$careServicesRequest/facilities/facility)
      else  $provs5

      let $provs7 :=  if (exists($careServicesRequest/organizations/organization))
	then csd_bl:filter_by_organizations($provs6,$careServicesRequest/organizations/organization)
      else  $provs6

      let $provs7a := if(exists($careServicesRequest/language))
	then csd_bl:filter_by_languages($provs7,$careServicesRequest/language)
      else $provs7

      let $provs8 := if(exists($careServicesRequest/cadre))
        then csd_bl:filter_by_cadres($provs7a,$careServicesRequest/cadre)
      else $provs7a

      let $provs9 := if(exists($careServicesRequest/region))
      	then
      		let $districts := data(/CSD/organizationDirectory/organization[./codedType/@code='DISTRICT' and ./organizations/organization[@entityID=data($careServicesRequest/region/@entityID)]]/@entityID)
      		return $provs8[./organizations/organization[@entityID = $districts]]
      	else $provs8

      return if (exists($careServicesRequest/start)) then
	if (exists($careServicesRequest/max))
	  then csd_bl:limit_items($provs9,$careServicesRequest/start,$careServicesRequest/max)
	else csd_bl:limit_items($provs9,$careServicesRequest/start,<max/>)
      else
	if (exists($careServicesRequest/max))
	  then csd_bl:limit_items($provs9,<start/>,$careServicesRequest/max)
	else $provs9

    }
  </providerDirectory>
</CSD>

import module namespace csd_bl = "https://github.com/openhie/openinfoman/csd_bl";
import module namespace csd_lib = "https://github.com/openhie/openinfoman-liberia/csd_lib";
declare default element  namespace   "urn:ihe:iti:csd:2013";
declare variable $careServicesRequest as item() external;

(:
   The query will be executed against the root element of the CSD document.

   The dynamic context of this query has $careServicesRequest set to contain any of the search
   and limit paramaters as sent by the Service Finder
:)

<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory/>
  <serviceDirectory/>
  <facilityDirectory/>
  <providerDirectory>
    {

      let $provs0 := if (exists($careServicesRequest/id))
	then csd_bl:filter_by_primary_id(/CSD/providerDirectory/*,$careServicesRequest/id)
      else /CSD/providerDirectory/*

      let $provs1 := if(exists($careServicesRequest/otherID))
	then csd_bl:filter_by_other_id($provs0,$careServicesRequest/otherID)
      else $provs0

      let $provs2 := if(exists($careServicesRequest/commonName))
	then csd_bl:filter_by_common_name($provs1,$careServicesRequest/commonName)
      else $provs1

      let $provs3 := if (exists($careServicesRequest/codedType))
	then csd_bl:filter_by_coded_type($provs2,$careServicesRequest/codedType)
      else $provs2

      let $provs4 := if (exists($careServicesRequest/address/addressLine))
	then csd_bl:filter_by_demographic_address($provs3, $careServicesRequest/address/addressLine)
      else $provs3

      let $provs5 :=  if (exists($careServicesRequest/record))
	then csd_bl:filter_by_record($provs4,$careServicesRequest/record)
      else  $provs4

      let $provs6 :=  if (exists($careServicesRequest/facilities/facility))
	then csd_bl:filter_by_facilities($provs5,$careServicesRequest/facilities/facility)
      else  $provs5

      let $provs7 :=  if (exists($careServicesRequest/organizations/organization))
	then csd_bl:filter_by_organizations($provs6,$careServicesRequest/organizations/organization)
      else  $provs6

      let $provs7a := if(exists($careServicesRequest/language))
	then csd_bl:filter_by_languages($provs7,$careServicesRequest/language)
      else $provs7

      let $provs8 := if(exists($careServicesRequest/cadre))
        then csd_bl:filter_by_cadres($provs7a,$careServicesRequest/cadre)
      else $provs7a

      let $provs9 := if(exists($careServicesRequest/region))
      	then
      		let $districts := data(/CSD/organizationDirectory/organization[./codedType/@code='DISTRICT' and ./organizations/organization[@entityID=data($careServicesRequest/region/@entityID)]]/@entityID)
      		return $provs8[./organizations/organization[@entityID = $districts]]
      	else $provs8

      return if (exists($careServicesRequest/start)) then
	if (exists($careServicesRequest/max))
	  then csd_bl:limit_items($provs9,$careServicesRequest/start,$careServicesRequest/max)
	else csd_bl:limit_items($provs9,$careServicesRequest/start,<max/>)
      else
	if (exists($careServicesRequest/max))
	  then csd_bl:limit_items($provs9,<start/>,$careServicesRequest/max)
	else $provs9

    }
  </providerDirectory>
</CSD>


Fix debugging MarkLogic queries.

Fix debugging MarkLogic queries.

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

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

declare namespace o = "http://reecedunn.co.uk/xquery/options";
declare namespace eval = "xdmp:eval";

declare option o:implementation "marklogic/6.0";

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

declare variable $mode as xs:string external := "run";
declare variable $mimetype as xs:string external := "application/xquery";
declare variable $module-path as xs:string external := "";
declare variable $query as xs:string external := "()";
declare variable $vars as xs:string external := "{}";
declare variable $types as xs:string external := "{}";
declare variable $context-value as xs:string external := "";
declare variable $context-path as xs:string external := "";
declare variable $rdf-output-format as xs:string external := "";
declare variable $updating as xs:string external := "false";
declare variable $server as xs:string external := "";
declare variable $database as xs:string external := "";
declare variable $module-root as xs:string external := "";

declare variable $content-type-header-prefix as xs:string external := "X-Content-Type-";
declare variable $derived-type-header-prefix as xs:string external := "X-Derived-";

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

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

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

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

declare function local:server-coordinate-system($server as xs:unsignedLong?) {
    let $server-coordinate-system := local:function("xdmp:server-coordinate-system#1")
    return if (exists($server) and exists($server-coordinate-system)) then
        $server-coordinate-system($server)
    else
        ()
};

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

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

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

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

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

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

declare function local:use-modules-root($server-root) {
    exists($server-root) and string-length($module-root) ne 0 and not($module-root eq $server-root)
};

declare function local:eval-static-check($static-check as xs:boolean) {
    if ($static-check eq true()) then
        <eval:static-check>true</eval:static-check>
    else
        ()
};

declare function local:eval-database($database as xs:unsignedLong?) {
    if (exists($database)) then
        <eval:database>{$database}</eval:database>
    else
        ()
};

declare function local:eval-default-collation($collation as xs:string?) {
    if (exists($collation)) then
        <eval:default-collation>{$collation}</eval:default-collation>
    else
        ()
};

declare function local:eval-default-coordinate-system($coordinate-system as xs:string?) {
    if (exists($coordinate-system)) then
        <eval:default-coordinate-system>{$coordinate-system}</eval:default-coordinate-system>
    else
        ()
};

declare function local:eval-default-xquery-version($xquery-version as xs:string?) {
    if (exists($xquery-version) and $mimetype eq "application/xquery") then
        <eval:default-xquery-version>{$xquery-version}</eval:default-xquery-version>
    else
        ()
};

declare function local:eval-modules($database as xs:unsignedLong?) {
    if (exists($database)) then
        <eval:modules>{$database}</eval:modules>
    else
        ()
};

declare function local:eval-root($root as xs:string?) {
    if (exists($root)) then
        <eval:root>{$root}</eval:root>
    else
        ()
};

declare function local:eval-update($update as xs:boolean) {
    let $major := local:version()
    let $minor := local:version-minor()
    return if ($mode = "debug") then
        if ($update) then
            fn:error(xs:QName("err:FOER0000"), "Debugging an update query is not supported by MarkLogic.")
        else
            ()
    else if ($major lt 7.0 or ($major eq 8.0 and $minor lt 7.0) or ($major eq 9.0 and $minor lt 2.0)) then
        if ($update) then
            <eval:transaction-mode>update</eval:transaction-mode>
        else
            <eval:transaction-mode>query</eval:transaction-mode>
    else
        (: MarkLogic 8.0-7 and 9.0-2 support <update> :)
        <eval:update>{$update}</eval:update>
};

declare function local:eval-options() {
    let $server := local:nullize($server) ! xdmp:server(.)
    let $database :=
        let $id := local:nullize($database) ! xdmp:database(.)
        return if (exists($id)) then
            $id
        else if (exists($server)) then
            xdmp:server-database($server)
        else
            ()
    let $server-root := $server ! xdmp:server-root(.)
    let $modules-database :=
        if (local:use-modules-root($server-root)) then
            0 (: file system :)
        else
            xdmp:server-modules-database($server)
    let $modules-root :=
        if ($modules-database eq 0) then
            if (exists($server-root) and (string-length($module-root) eq 0 or $module-root eq "/")) then
                $server-root
            else
                $module-root
        else
            $server-root
    return <eval:options>{
        local:eval-static-check($mode eq "validate"),
        local:eval-database($database),
        local:eval-default-collation($server ! xdmp:server-collation(.)),
        local:eval-default-coordinate-system($server ! local:server-coordinate-system(.)),
        local:eval-default-xquery-version($server ! xdmp:server-default-xquery-version($server)),
        local:eval-modules($modules-database),
        local:eval-root($modules-root),
        local:eval-update($updating eq "true")
    }</eval:options>
};

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

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

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

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

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

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

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

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

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

declare namespace o = "http://reecedunn.co.uk/xquery/options";
declare namespace eval = "xdmp:eval";

declare option o:implementation "marklogic/6.0";

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

declare variable $mode as xs:string external := "run";
declare variable $mimetype as xs:string external := "application/xquery";
declare variable $module-path as xs:string external := "";
declare variable $query as xs:string external := "()";
declare variable $vars as xs:string external := "{}";
declare variable $types as xs:string external := "{}";
declare variable $context-value as xs:string external := "";
declare variable $context-path as xs:string external := "";
declare variable $rdf-output-format as xs:string external := "";
declare variable $updating as xs:string external := "false";
declare variable $server as xs:string external := "";
declare variable $database as xs:string external := "";
declare variable $module-root as xs:string external := "";

declare variable $content-type-header-prefix as xs:string external := "X-Content-Type-";
declare variable $derived-type-header-prefix as xs:string external := "X-Derived-";

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

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

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

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

declare function local:server-coordinate-system($server as xs:unsignedLong?) {
    let $server-coordinate-system := local:function("xdmp:server-coordinate-system#1")
    return if (exists($server) and exists($server-coordinate-system)) then
        $server-coordinate-system($server)
    else
        ()
};

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

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

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

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

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

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

declare function local:use-modules-root($server-root) {
    exists($server-root) and string-length($module-root) ne 0 and not($module-root eq $server-root)
};

declare function local:eval-static-check($static-check as xs:boolean) {
    <eval:static-check>{$static-check}</eval:static-check>
};

declare function local:eval-database($database as xs:unsignedLong?) {
    if (exists($database)) then
        <eval:database>{$database}</eval:database>
    else
        ()
};

declare function local:eval-default-collation($collation as xs:string?) {
    if (exists($collation)) then
        <eval:default-collation>{$collation}</eval:default-collation>
    else
        ()
};

declare function local:eval-default-coordinate-system($coordinate-system as xs:string?) {
    if (exists($coordinate-system)) then
        <eval:default-coordinate-system>{$coordinate-system}</eval:default-coordinate-system>
    else
        ()
};

declare function local:eval-default-xquery-version($xquery-version as xs:string?) {
    if (exists($xquery-version) and $mimetype eq "application/xquery") then
        <eval:default-xquery-version>{$xquery-version}</eval:default-xquery-version>
    else
        ()
};

declare function local:eval-modules($database as xs:unsignedLong?) {
    if (exists($database)) then
        <eval:modules>{$database}</eval:modules>
    else
        ()
};

declare function local:eval-root($root as xs:string?) {
    if (exists($root)) then
        <eval:root>{$root}</eval:root>
    else
        ()
};

declare function local:eval-update($update as xs:boolean) {
    let $major := local:version()
    let $minor := local:version-minor()
    return if ($mode = "debug") then
        if ($update) then
            fn:error(xs:QName("err:FOER0000"), "Debugging an update query is not supported by MarkLogic.")
        else
            ()
    else if ($major lt 7.0 or ($major eq 8.0 and $minor lt 7.0) or ($major eq 9.0 and $minor lt 2.0)) then
        if ($update) then
            <eval:transaction-mode>update</eval:transaction-mode>
        else
            <eval:transaction-mode>query</eval:transaction-mode>
    else
        (: MarkLogic 8.0-7 and 9.0-2 support <update> :)
        <eval:update>{$update}</eval:update>
};

declare function local:eval-options() {
    let $server := local:nullize($server) ! xdmp:server(.)
    let $database :=
        let $id := local:nullize($database) ! xdmp:database(.)
        return if (exists($id)) then
            $id
        else if (exists($server)) then
            xdmp:server-database($server)
        else
            ()
    let $server-root := $server ! xdmp:server-root(.)
    let $modules-database :=
        if (local:use-modules-root($server-root)) then
            0 (: file system :)
        else
            xdmp:server-modules-database($server)
    let $modules-root :=
        if ($modules-database eq 0) then
            if (exists($server-root) and (string-length($module-root) eq 0 or $module-root eq "/")) then
                $server-root
            else
                $module-root
        else
            $server-root
    return <eval:options>{
        local:eval-static-check($mode eq "validate"),
        local:eval-database($database),
        local:eval-default-collation($server ! xdmp:server-collation(.)),
        local:eval-default-coordinate-system($server ! local:server-coordinate-system(.)),
        local:eval-default-xquery-version($server ! xdmp:server-default-xquery-version($server)),
        local:eval-modules($modules-database),
        local:eval-root($modules-root),
        local:eval-update($updating eq "true")
    }</eval:options>
};

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

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

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

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

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

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

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


Removed sequential lets.

Removed sequential lets.

(:
 : Copyright 2006-2009 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.
:)

(:~
 : This module provides an interface for zorbas http client. Basically it
 : provides functions for simple http requests (GET, POST, DELETE etc.)
 : and a general purpose function. If the simple functions are not enough
 : powerfull for your needs, you should use the implementation of the EXPath
 : module instead. See the spec
 : of the http-client for more information about EXPaths http-client.
 :
 : While the EXPath functions are all declared as sequential, some functions in
 : this module are defined as nondeterministic. But if you are making a request
 : with one of these modules to a server which does not conform to the HTTP
 : RFC (and which introduces side effects for side-effect free calls like GET),
 : use the EXPath module instead. Otherwise the behavior of your problem will
 : be undefined.
 :
 : Examples of how to use this module:
 :
 : Simple GET Request (retrieving HTML)
 :
 :
http:get( "www.example.com" )

 :
 : returns
 :
 :

 :   <response xmlns="http://expath.org/ns/http-client" status="200" message="OK">
 :     <header name="Content-Type" value="text/html; charset=UTF-8"/>
 :     <header name="Content-Length" value="574"/>
 :     ...
 :     <body media-type="text/html"/>
 :   </response>
 :   <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
 :   <html>
 :     <head>
 :       <meta http-equiv="Content-Type"
 :       content="text/html; charset=utf-8" />
 :       <title>Example Web Page</title>
 :     </head>
 :     <body>
 :       <p>You have reached this web page by typing "example.com",
 :       "example.net", or "example.org" into your web browser.</p>
 :       <p>These domain names are reserved for use in documentation and are
 :       Not available for registration. See
 :       <a href="http://www.rfc-editor.org/rfc/rfc2606.txt">RFC 2606</a>,
 :       Section 3.</p>
 :     </body>
 :   </html>
 :

 :
 : Simple GET Request (retrieving XHTML)
 :
 :

 :   declare namespace xhtml="http://www.w3.org/1999/xhtml";
 :
 :   http:get( "www.w3.org" )[2]//xhtml:body
 :

 :
 :

 : This example shows how to retrieve an XHTML resource. Note, that the node test
 : that is looking for the body element in the result requires the xhtml
 : namespace to be specified.
 :

 :
 : Simple POST Request
 :
 :

 : Here is a simple example which sends a text content by making an HTTP POST
 : request.
 :

 :
 :

 :   http:post( "...", "Hello World" )
 :

 :
 : The response of this request can look as follows:
 :
 :

 :   <http:response status="200" message="Ok">
 :      <http:header name="Content-Type" value="text/html"/>
 :      <http:header name="Server" value="Apache ..."/>
 :      ...
 :      <http:body content-type="text/html"/>
 :   </http:response>
 :

 :
 : @author Markus Pilman
 : @see XQuery 1.1: Function Declaration
 : @library cURL Library
 :
 :)
module namespace http = "http://www.zorba-xquery.com/modules/http-client";

import module namespace err = "http://expath.org/ns/error";

import module namespace tidy="http://www.zorba-xquery.com/modules/convertors/html";
import schema namespace tidy-options="http://www.zorba-xquery.com/modules/convertors/html-options";

import schema namespace https = "http://expath.org/ns/http-client";

(:~
 : This function sends an HTTP request and returns the corresponding response. It just
 : implements the http:send-request/3 function from the EXPath module. To provide better
 : interoperability between XQuery engines, use the EXPath module instead.
 :
 :

 : This function is declared as sequential (see XQuery Scripting).
 : Sequential functions are allowed to have side effects. For example, most probably,
 : an HTTP POST request is a request that has side effects because it adds/changes
 : a remote resource.
 :

 :
 : @param $request Contains the various parameters of the request.
 :   See the
 :   specification.
 :   for a full description of the structure of this element.
 : @param $href is the HTTP or HTTPS URI to send the request to. It must be a valid
 :  xs:anyURI, but is declared as a string to be able to pass literal strings
 :  (without requiring to explicitly cast it to an xs:anyURI.)
 : @param $content is the request body content, for HTTP methods that can
 :  contain a body in the request (i.e. POST and PUT). It is an error, if this
 :  param is not the empty sequence for methods other then DELETE, GET, HEAD
 :  and OPTIONS.
 : @return a sequence of items, where the first item is a element of type
 :  http:responseType. The response element is also described in the
 :  specification.
 :  If there is one (or several, in case of multipart) response body, the response bodies
 :  are the next items in the sequence.
 :)
declare %sequential function http:send-request(
  $request as element(https:request)?,
  $href as xs:string?,
  $bodies as item()*) as item()+
{
  if (http:check-params($request, $href, $bodies))
  then
    block
    {
      declare $req := if ($request)
                      then
                        try
                        {
                          validate { http:set-content-type($request) }
                        }
                        catch XQDY0027
                        {
                          fn:error($err:HC005, "The request element is not valid.")
                        }
                      else
                       ();

      declare $result := http:http-sequential-impl($req, $href, $bodies);

      http:tidy-result($result, fn:data($request/@override-media-type));
    }
  else
    ();
};

(:~
 : This function makes a GET request on a given URL.
 :
 : This function just makes a http GET request on $href. The function
 : is nondeterministic. But if a GET request to the given address has
 : side effects, which would not conform with the RFC but is often the
 : case, then you should use a sequential function instead.
 :
 : @param $href The URL to which the call will be made.
 : @return a sequence of items, where the first item is a element of type
 :  http:responseType. The response element is also described in the
 :  specification.
 :  If there is one (or several, in case of multipart) response body, the response bodies
 :  are the next items in the sequence.
 :)
declare function http:get($href as xs:string) as item()+
{
  http:tidy-result(http:http-nondeterministic-impl((), $href, ()), ())
};

(:~
 : Makes a HTTP HEAD request.
 :
 : @param $href The URL to which the request will be made.
 : @return A element which describes the result of this request. A http HEAD
 :         request never returns a body.
 :)
declare function http:head($href as xs:string) as item() {
  http:http-nondeterministic-impl(
    validate {
      <https:request method="HEAD" href="{$href}">
      </https:request>
    }, (), ())
};

(:~
 : Makes a HTTP OPTIONS request.
 :
 : This request ask for OPTIONS supported of the server.
 :
 : @param $href The URL where to send the request.
 : @return A sequence of string with the allowed operations
 :)
declare function http:options($href as xs:string) as xs:string* {
  let $resp := http:http-nondeterministic-impl(
    validate {
      <https:request method="OPTIONS" href="{$href}">
      </https:request>
    }, (), ())[1]
  return
    fn:tokenize(fn:data($resp/https:header[@name = "Allow"]/@value), ",")
};

(:~
 : Makes a HTTP PUT request.
 :
 : @param $href The URL where to send the request.
 : @param $body The body which will be sent to the server
 : @return The first element of the result is the metadata (like
 :         headers, status etc), the next elements are the response
 :)
declare %sequential function http:put($href as xs:string, $body as item()) as item()+
{
  declare $media-type as xs:string+ :=
    typeswitch($body)
      case xs:string return ("text/plain","text")
      case element() return ("text/xml", "xml")
      default return ("text/plain","xml");

  declare $result := http:http-sequential-impl(validate {
    <https:request href="{$href}" method="PUT">
      <https:body media-type="{$media-type[1]}" method="{$media-type[2]}">{$body}</https:body>
    </https:request>}
    , (), ());

  http:tidy-result($result, ());
};

(:~
 : Makes a HTTP DELETE request.
 :
 : @param $href The URL where to send the request.
 : @return The first element of the result is the metadata (like
 :         headers, status etc), the next elements are the response
 :)
declare %sequential function http:delete($href as xs:string) as item()+
{
  http:http-nondeterministic-impl(
    validate {
      <https:request method="DELETE" href="{$href}">
      </https:request>
    }, (), ())
};

(:~
 : Makes a HTTP POST request.
 :
 : This function supports only simple http POST requests which should suite
 : most of the mostly common requests. Unlike the send-request function from
 : the EXPath http client, the user only has to give a URL, where she wants
 : the request sent to and a body as an item. The body will than be serialized
 : as follows:
 :

 :
If $body is of type xs:string, it will be serialized as plain text and
 :        the Content-Type for the request will be set to "text/plain"

 :
If $body is an element node, the Content-Type will be set to "text/xml"
 :        and the element will be serialized as xml.

 :

 :
 : @param $href The URL where to send the request.
 : @param $body The body which will be sent to the server
 : @return The first element of the result is the metadata (like
 :         headers, status etc), the next elements are the response
 :)
declare %sequential function http:post($href as xs:string, $body as item()) as item()+
{
  declare $media-type as xs:string+ :=
    typeswitch($body)
      case xs:string return ("text/plain","text")
      case element() return ("text/xml", "xml")
      default return ("text/plain","xml");

  declare $result := http:http-sequential-impl(validate {
    <https:request href="{$href}" method="POST">
      <https:body media-type="{$media-type[1]}" method="{$media-type[2]}">{$body}</https:body>
    </https:request>}
    , (), ());

  http:tidy-result($result, ());
};

declare %private %sequential function http:http-sequential-impl(
  $request as schema-element(https:request)?,
  $href as xs:string?,
  $bodies as item()*) as item()+ external;

declare %private %nondeterministic function http:http-nondeterministic-impl(
  $request as schema-element(https:request)?,
  $href as xs:string?,
  $bodies as item()*) as item()+ external;

declare %private function http:tidy-result($result as item()+, $override-media-type as xs:string?) as item()+
{
  $result[1],
  for $body at $pos in fn:subsequence($result, 2)
  let $media-type := ($override-media-type, $result[1]//https:body[$pos]/@media-type/fn:data(.))[1]
  return
    if ($media-type eq "text/html") then
      tidy:parse($body)
    else
      $body
};

(:~
 : This function takes an https:body element, copies it, and
 : adds a method attribute to the copy if there is none
 : in the original element.
 :
 : @param $body is the original https:body element
 : @return a https:body element with a corresponding @method
 :   attribute
 :)
declare %private function http:create-body (
  $body as element(https:body))
    as element(https:body) {
  <https:body>{$body/@*}
  {
    if ($body/@method) then
      ()
    else
      attribute method {
        if ($body/@media-type eq "text/xml" or
            $body/@media-type eq "application/xml" or
            $body/@media-type eq "text/xml-external-parsed-entity" or
            $body/@media-type eq "application/xml-external-parsed-entity") then
              "xml"
         else if ($body/@media-type eq "text/html") then "html"
         else if (fn:starts-with($body/@media-type/data(.), "text/")) then "text"
         else "binary"
      }
  }
  {$body/node()}
  </https:body>
};

(:~
 : This function takes an https:multipart element, copies it and
 : adds a @method attribute to all body elements which don't have
 : one.
 :
 : @param $multipart the original https:multipart
 : @return a copy of $multipart with all $multipart/body/@method set
 :)
declare %private function http:create-multipart (
  $multipart as element(https:multipart))
    as element(https:multipart) {
    <https:multipart>{$multipart/@*}
    {
    for $x in $multipart/node()
    return
      typeswitch($x)
        case element(https:body) return http:create-body($x)
        default return $x
    }
    </https:multipart>
};

(:~
 : This adds a default method attribute to all body elements which
 : don't contain a method attribute.
 :
 : @param $request The request which need to be copied.
 : @return A copy of $request with all request//body/@method set.
 :)
declare %private function http:set-content-type(
  $request as element(https:request)?)
    as element(https:request)? {
  if ($request) then
    <https:request>{$request/@*}
    {
    for $x in $request/node()
    return
      typeswitch($x)
        case element(https:body) return http:create-body($x)
        case element(https:multipart) return http:create-multipart($x)
        default return $x
    }
    </https:request>
  else ()
};

(:~
 : Private function used internally by this module.
 :
 : This function checks if the request, href, and bodies parameters
 : are consistent.
 :
 : @param $request The request which needs to be checked.
 : @param $href The href which needs to be checked.
 : @param $bodies The bodies element which needs to be checked.
 : @return true if the parameters are consistent. Otherwise,
 :         this function raises an error.
 :)
declare %private function http:check-params(
  $request as element(https:request)?,
  $href as xs:string?,
  $bodies as item()*) as xs:boolean {
  let $multipart := $request/http:multipart
  let $override := $request/@override-media-type/data(.)
  let $should-be-empty :=
    for $x in $request//https:body
    return
      if ($x/@src and fn:not((fn:count($x/@*) eq 2))) then 1
      else ()
  return
    if (fn:empty($href) and fn:empty($request)) then
      fn:error($err:HC005, "The request element is not valid.")
    else if ($href eq "") then
      fn:error($err:HC005,
        "The request element is not valid.")
    else if (not(count($request//https:body[not(exists(node())) and not(exists(@src))]) eq count($bodies))) then
      fn:error($err:HC005,
        "The request element is not valid.")
    else if ($should-be-empty) then
      fn:error($err:HC004, "The src attribute on the body element is mutually exclusive with all other attribute (except the media-type).")
    else
      fn:true()
};

(:
 : Copyright 2006-2009 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.
:)

(:~
 : This module provides an interface for zorbas http client. Basically it
 : provides functions for simple http requests (GET, POST, DELETE etc.)
 : and a general purpose function. If the simple functions are not enough
 : powerfull for your needs, you should use the implementation of the EXPath
 : module instead. See the spec
 : of the http-client for more information about EXPaths http-client.
 :
 : While the EXPath functions are all declared as sequential, some functions in
 : this module are defined as nondeterministic. But if you are making a request
 : with one of these modules to a server which does not conform to the HTTP
 : RFC (and which introduces side effects for side-effect free calls like GET),
 : use the EXPath module instead. Otherwise the behavior of your problem will
 : be undefined.
 :
 : Examples of how to use this module:
 :
 : Simple GET Request (retrieving HTML)
 :
 :
http:get( "www.example.com" )

 :
 : returns
 :
 :

 :   <response xmlns="http://expath.org/ns/http-client" status="200" message="OK">
 :     <header name="Content-Type" value="text/html; charset=UTF-8"/>
 :     <header name="Content-Length" value="574"/>
 :     ...
 :     <body media-type="text/html"/>
 :   </response>
 :   <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
 :   <html>
 :     <head>
 :       <meta http-equiv="Content-Type"
 :       content="text/html; charset=utf-8" />
 :       <title>Example Web Page</title>
 :     </head>
 :     <body>
 :       <p>You have reached this web page by typing "example.com",
 :       "example.net", or "example.org" into your web browser.</p>
 :       <p>These domain names are reserved for use in documentation and are
 :       Not available for registration. See
 :       <a href="http://www.rfc-editor.org/rfc/rfc2606.txt">RFC 2606</a>,
 :       Section 3.</p>
 :     </body>
 :   </html>
 :

 :
 : Simple GET Request (retrieving XHTML)
 :
 :

 :   declare namespace xhtml="http://www.w3.org/1999/xhtml";
 :
 :   http:get( "www.w3.org" )[2]//xhtml:body
 :

 :
 :

 : This example shows how to retrieve an XHTML resource. Note, that the node test
 : that is looking for the body element in the result requires the xhtml
 : namespace to be specified.
 :

 :
 : Simple POST Request
 :
 :

 : Here is a simple example which sends a text content by making an HTTP POST
 : request.
 :

 :
 :

 :   http:post( "...", "Hello World" )
 :

 :
 : The response of this request can look as follows:
 :
 :

 :   <http:response status="200" message="Ok">
 :      <http:header name="Content-Type" value="text/html"/>
 :      <http:header name="Server" value="Apache ..."/>
 :      ...
 :      <http:body content-type="text/html"/>
 :   </http:response>
 :

 :
 : @author Markus Pilman
 : @see XQuery 1.1: Function Declaration
 : @library cURL Library
 :
 :)
module namespace http = "http://www.zorba-xquery.com/modules/http-client";

import module namespace err = "http://expath.org/ns/error";

import module namespace tidy="http://www.zorba-xquery.com/modules/convertors/html";
import schema namespace tidy-options="http://www.zorba-xquery.com/modules/convertors/html-options";

import schema namespace https = "http://expath.org/ns/http-client";

(:~
 : This function sends an HTTP request and returns the corresponding response. It just
 : implements the http:send-request/3 function from the EXPath module. To provide better
 : interoperability between XQuery engines, use the EXPath module instead.
 :
 :

 : This function is declared as sequential (see XQuery Scripting).
 : Sequential functions are allowed to have side effects. For example, most probably,
 : an HTTP POST request is a request that has side effects because it adds/changes
 : a remote resource.
 :

 :
 : @param $request Contains the various parameters of the request.
 :   See the
 :   specification.
 :   for a full description of the structure of this element.
 : @param $href is the HTTP or HTTPS URI to send the request to. It must be a valid
 :  xs:anyURI, but is declared as a string to be able to pass literal strings
 :  (without requiring to explicitly cast it to an xs:anyURI.)
 : @param $content is the request body content, for HTTP methods that can
 :  contain a body in the request (i.e. POST and PUT). It is an error, if this
 :  param is not the empty sequence for methods other then DELETE, GET, HEAD
 :  and OPTIONS.
 : @return a sequence of items, where the first item is a element of type
 :  http:responseType. The response element is also described in the
 :  specification.
 :  If there is one (or several, in case of multipart) response body, the response bodies
 :  are the next items in the sequence.
 :)
declare %sequential function http:send-request(
  $request as element(https:request)?,
  $href as xs:string?,
  $bodies as item()*) as item()+ {
  if (http:check-params($request, $href, $bodies))
  then
    let $req := if ($request) then
      try {
        validate { http:set-content-type($request) }
      } catch XQDY0027 {
        fn:error($err:HC005, "The request element is not valid.")
      }
    else ()
    let $result := http:http-sequential-impl($req,
                                             $href,
                                             $bodies)
    return http:tidy-result($result, fn:data($request/@override-media-type))
  else ();
};

(:~
 : This function makes a GET request on a given URL.
 :
 : This function just makes a http GET request on $href. The function
 : is nondeterministic. But if a GET request to the given address has
 : side effects, which would not conform with the RFC but is often the
 : case, then you should use a sequential function instead.
 :
 : @param $href The URL to which the call will be made.
 : @return a sequence of items, where the first item is a element of type
 :  http:responseType. The response element is also described in the
 :  specification.
 :  If there is one (or several, in case of multipart) response body, the response bodies
 :  are the next items in the sequence.
 :)
declare function http:get($href as xs:string) as item()+
{
  http:tidy-result(http:http-nondeterministic-impl((), $href, ()), ())
};

(:~
 : Makes a HTTP HEAD request.
 :
 : @param $href The URL to which the request will be made.
 : @return A element which describes the result of this request. A http HEAD
 :         request never returns a body.
 :)
declare function http:head($href as xs:string) as item() {
  http:http-nondeterministic-impl(
    validate {
      <https:request method="HEAD" href="{$href}">
      </https:request>
    }, (), ())
};

(:~
 : Makes a HTTP OPTIONS request.
 :
 : This request ask for OPTIONS supported of the server.
 :
 : @param $href The URL where to send the request.
 : @return A sequence of string with the allowed operations
 :)
declare function http:options($href as xs:string) as xs:string* {
  let $resp := http:http-nondeterministic-impl(
    validate {
      <https:request method="OPTIONS" href="{$href}">
      </https:request>
    }, (), ())[1]
  return
    fn:tokenize(fn:data($resp/https:header[@name = "Allow"]/@value), ",")
};

(:~
 : Makes a HTTP PUT request.
 :
 : @param $href The URL where to send the request.
 : @param $body The body which will be sent to the server
 : @return The first element of the result is the metadata (like
 :         headers, status etc), the next elements are the response
 :)
declare %sequential function http:put($href as xs:string, $body as item()) as item()+
{
  let $media-type as xs:string+ :=
    typeswitch($body)
      case xs:string return ("text/plain","text")
      case element() return ("text/xml", "xml")
      default return ("text/plain","xml")
  let $result := http:http-sequential-impl(validate {
    <https:request href="{$href}" method="PUT">
      <https:body media-type="{$media-type[1]}" method="{$media-type[2]}">{$body}</https:body>
    </https:request>}
    , (), ())
  return http:tidy-result($result, ())
};

(:~
 : Makes a HTTP DELETE request.
 :
 : @param $href The URL where to send the request.
 : @return The first element of the result is the metadata (like
 :         headers, status etc), the next elements are the response
 :)
declare %sequential function http:delete($href as xs:string) as item()+
{
  http:http-nondeterministic-impl(
    validate {
      <https:request method="DELETE" href="{$href}">
      </https:request>
    }, (), ())
};

(:~
 : Makes a HTTP POST request.
 :
 : This function supports only simple http POST requests which should suite
 : most of the mostly common requests. Unlike the send-request function from
 : the EXPath http client, the user only has to give a URL, where she wants
 : the request sent to and a body as an item. The body will than be serialized
 : as follows:
 :

 :
If $body is of type xs:string, it will be serialized as plain text and
 :        the Content-Type for the request will be set to "text/plain"

 :
If $body is an element node, the Content-Type will be set to "text/xml"
 :        and the element will be serialized as xml.

 :

 :
 : @param $href The URL where to send the request.
 : @param $body The body which will be sent to the server
 : @return The first element of the result is the metadata (like
 :         headers, status etc), the next elements are the response
 :)
declare %sequential function http:post($href as xs:string, $body as item()) as item()+
{
  let $media-type as xs:string+ :=
    typeswitch($body)
      case xs:string return ("text/plain","text")
      case element() return ("text/xml", "xml")
      default return ("text/plain","xml")
  let $result := http:http-sequential-impl(validate {
    <https:request href="{$href}" method="POST">
      <https:body media-type="{$media-type[1]}" method="{$media-type[2]}">{$body}</https:body>
    </https:request>}
    , (), ())
  return http:tidy-result($result, ())
};

declare %private %sequential function http:http-sequential-impl(
  $request as schema-element(https:request)?,
  $href as xs:string?,
  $bodies as item()*) as item()+ external;

declare %private %nondeterministic function http:http-nondeterministic-impl(
  $request as schema-element(https:request)?,
  $href as xs:string?,
  $bodies as item()*) as item()+ external;

declare %private function http:tidy-result($result as item()+, $override-media-type as xs:string?) as item()+
{
  $result[1],
  for $body at $pos in fn:subsequence($result, 2)
  let $media-type := ($override-media-type, $result[1]//https:body[$pos]/@media-type/fn:data(.))[1]
  return
    if ($media-type eq "text/html") then
      tidy:parse($body)
    else
      $body
};

(:~
 : This function takes an https:body element, copies it, and
 : adds a method attribute to the copy if there is none
 : in the original element.
 :
 : @param $body is the original https:body element
 : @return a https:body element with a corresponding @method
 :   attribute
 :)
declare %private function http:create-body (
  $body as element(https:body))
    as element(https:body) {
  <https:body>{$body/@*}
  {
    if ($body/@method) then
      ()
    else
      attribute method {
        if ($body/@media-type eq "text/xml" or
            $body/@media-type eq "application/xml" or
            $body/@media-type eq "text/xml-external-parsed-entity" or
            $body/@media-type eq "application/xml-external-parsed-entity") then
              "xml"
         else if ($body/@media-type eq "text/html") then "html"
         else if (fn:starts-with($body/@media-type/data(.), "text/")) then "text"
         else "binary"
      }
  }
  {$body/node()}
  </https:body>
};

(:~
 : This function takes an https:multipart element, copies it and
 : adds a @method attribute to all body elements which don't have
 : one.
 :
 : @param $multipart the original https:multipart
 : @return a copy of $multipart with all $multipart/body/@method set
 :)
declare %private function http:create-multipart (
  $multipart as element(https:multipart))
    as element(https:multipart) {
    <https:multipart>{$multipart/@*}
    {
    for $x in $multipart/node()
    return
      typeswitch($x)
        case element(https:body) return http:create-body($x)
        default return $x
    }
    </https:multipart>
};

(:~
 : This adds a default method attribute to all body elements which
 : don't contain a method attribute.
 :
 : @param $request The request which need to be copied.
 : @return A copy of $request with all request//body/@method set.
 :)
declare %private function http:set-content-type(
  $request as element(https:request)?)
    as element(https:request)? {
  if ($request) then
    <https:request>{$request/@*}
    {
    for $x in $request/node()
    return
      typeswitch($x)
        case element(https:body) return http:create-body($x)
        case element(https:multipart) return http:create-multipart($x)
        default return $x
    }
    </https:request>
  else ()
};

(:~
 : Private function used internally by this module.
 :
 : This function checks if the request, href, and bodies parameters
 : are consistent.
 :
 : @param $request The request which needs to be checked.
 : @param $href The href which needs to be checked.
 : @param $bodies The bodies element which needs to be checked.
 : @return true if the parameters are consistent. Otherwise,
 :         this function raises an error.
 :)
declare %private function http:check-params(
  $request as element(https:request)?,
  $href as xs:string?,
  $bodies as item()*) as xs:boolean {
  let $multipart := $request/http:multipart
  let $override := $request/@override-media-type/data(.)
  let $should-be-empty :=
    for $x in $request//https:body
    return
      if ($x/@src and fn:not((fn:count($x/@*) eq 2))) then 1
      else ()
  return
    if (fn:empty($href) and fn:empty($request)) then
      fn:error($err:HC005, "The request element is not valid.")
    else if ($href eq "") then
      fn:error($err:HC005,
        "The request element is not valid.")
    else if (not(count($request//https:body[not(exists(node())) and not(exists(@src))]) eq count($bodies))) then
      fn:error($err:HC005,
        "The request element is not valid.")
    else if ($should-be-empty) then
      fn:error($err:HC004, "The src attribute on the body element is mutually exclusive with all other attribute (except the media-type).")
    else
      fn:true()
};