Add xf:template and xf:snippet

Add xf:template and xf:snippet

xquery version "3.0";

(:~
 : Origami templating.
 :
 : Requires Basex 8.0 20141221 or later.
 :
 : @version 0.4
 : @author Marc van Grootel
 : @see https://github.com/xokomola/origami
 :)

module namespace xf = 'http://xokomola.com/xquery/origami';

(:~
 : Load an HTML resource.
 :)
declare function xf:html-resource($url-or-path) {
    if (starts-with($url-or-path,'http:/')) then
        xf:fetch-html($url-or-path)
    else
        xf:parse-html($url-or-path)
};

(:~
 : Load an XML resource.
 :)
declare function xf:xml-resource($url-or-path) {
    doc($url-or-path)
};

(:~
 : Fetch and parse HTML given a URL.
 :)
declare function xf:fetch-html($url) {
    html:parse(fetch:binary($url))
};

(:~
 : Parse HTML from a filesystem path.
 :)
declare function xf:parse-html($path) {
    html:parse(file:read-binary($path))
};

(:~
 : Returns a template.
 :)
declare function xf:template($template as node(), $selector as array(*), $slots as array(*)*)
    as function(item()?) as node()* {
    function($args as item()?) {
        $template => xf:extract($selector) => xf:transform($slots)
    }
};

declare function xf:template($template as node(), $slots as array(*)*)
    as function(item()?) as node()* {
    function($args as item()?) {
        $template => xf:transform($slots)
    }
};

(:~
 : Returns a template.
 :)
declare function xf:snippet($template as node(), $selector as array(*))
    as function(item()?) as node()* {
    function($args as item()?) as node()* {
        $template => xf:at($selector)
    }
};

declare function xf:get($name as xs:string) {
    function($args as map(*)) {
        $args($name)
    }
};

(:~
 : Returns a Transformer function.
 :)
declare function xf:transform($templates as array(*)*)
    as function(node()*) as node()* {
    let $templates :=
        for $template in $templates
        return xf:match($template)
    return
        function($nodes as node()*) as node()* {
            xf:apply-nodes($nodes, (), $templates)
        }
};

(:~
 : Transform input, using the specified templates.
 :)
declare function xf:transform($nodes as node()*, $templates as array(*)*)
    as node()* {
    xf:transform($templates)($nodes)
};

(:~
 : Identity transformer.
 :)
declare function xf:transform() { xf:transform(()) };

(:~
 : Returns an extractor function that only returns selected nodes
 : only outermost, in document order and duplicates eliminated.
 :)
declare function xf:extract($selectors as array(*)*)
    as function(node()*) as node()* {
    xf:extract-outer($selectors)
};

(:~
 : Extracts nodes from input, using the specified selectors.
 :)
declare function xf:extract($nodes as node()*, $selectors as array(*)*)
    as node()* {
    xf:extract($selectors)($nodes)
};

(:~
 : Returns an extractor function that returns selected nodes,
 : only innermost, in document order and duplicates eliminitated.
 :)
declare function xf:extract-inner($selectors as array(*)*)
    as function(node()*) as node()* {
    let $selectors :=
        for $selector in $selectors
        return
            xf:at($selector)
    return
        function($nodes as node()*) as node()* {
            innermost(
                for $selector in $selectors
                return $selector($nodes)
            )
        }
};

declare function xf:extract-inner($nodes as node()*, $selectors as array(*)*)
    as node()* {
    xf:extract-inner($selectors)($nodes)
};

(:~
 : Returns an extractor function that returns selected nodes,
 : only outermost, in document order and duplicates eliminated.
 :)
declare function xf:extract-outer($selectors as array(*)*)
    as function(node()*) as node()* {
    let $selectors :=
        for $selector in $selectors
        return xf:at($selector)
    return
        function($nodes as node()*) as node()* {
            outermost(
                for $selector in $selectors
                return $selector($nodes)
            )
        }
};

declare function xf:extract-outer($nodes as node()*, $selectors as array(*)*)
    as node()* {
    xf:extract-outer($selectors)($nodes)
};

(:~
 : Defines a match template.
 :
 : A template takes a selector string or function and
 : a node transformation function or the items to return as
 : the template body.
 : Providing invalid matcher returns empty sequence.
 :)
declare function xf:match($template as array(*))
    as map(*)? {
    let $selector := xf:selector([array:head($template)], xf:select#1)
    let $body := xf:do(array:tail($template))
    where array:size($template) gt 0
    return
        map {
            'select': $selector,
            'fn': $body
        }
};

declare function xf:at($steps as array(*))
    as function(node()*) as node()* {
    xf:selector($steps, xf:select-all#1)
};

(:~
 : Execute a chain of node selectors.
 :)
declare function xf:at($nodes as node()*, $selector as item()*) {
    xf:at($selector)($nodes)
};

declare %private function xf:selector($steps as array(*))
    as function(node()*) as node()* {
    xf:selector($steps, xf:select-all#1)
};
(:~
 : Only nodes for which the chain of expressions evaluates to `true()`
 : are passed through.
 :)
declare function xf:if($conditions as item()*)
    as function(node()*) as node()* {
    let $conditions := xf:comp-expression($conditions)
    return
        function($nodes as node()*) as node()* {
            fold-left(
                $conditions,
                $nodes,
                function($result, $step) {
                    if ($step($result)) then
                       $result
                    else
                        ()
                }
            )
        }
};

(:~
 : Filter nodes based on evaluating a chain of expressions, letting only
 : those nodes through for which it returns `true()`.
 :)
declare function xf:if($nodes as node()*, $conditions as item()*)
    as node()* {
    xf:if($conditions)($nodes)
};

(:~
 : Compose a chain of node transformers.
 :)
declare function xf:do($fns as array(*))
    as function(node()*) as node()* {
    function($nodes as node()*) as node()* {
        array:fold-left(
            $fns,
            $nodes,
            function($nodes, $fn) {
                if ($fn instance of function(*)) then
                    $fn($nodes)
                else if ($fn instance of node()*) then
                    $fn
                else
                    ()
            }
        )
    }
};

(:~
 : Execute a chain of node transformers.
 :)
declare function xf:do($nodes as node()*, $fns as array(*))
    as node()* {
    xf:do($fns)($nodes)
};

(:~
 : Replace the content (child nodes) of the input node
 :)
declare function xf:content($content as node()*)
    as function(element()?) as element()? {
    function($element as element()?) as element()? {
        if (exists($element)) then
            element { node-name($element) } {
                $element/@*,
                $content
            }
        else
            $element
    }
};

declare function xf:content($element as element()?, $content as node()*)
    as element()? {
    xf:content($content)($element)
};

(:~
 : Only replace the content of the input element when
 : the content is not empty.
 :)
declare function xf:content-if($content as node()*)
    as function(element()?) as element()? {
    function($element as element()?) as element()? {
        if (exists($content) and exists($element)) then
            element { node-name($element) } {
                $element/@*,
                $content
            }
        else
            $element
    }
};

declare function xf:content-if($element as element()?, $content as node()*)
    as element()? {
    xf:content-if($content)($element)
};

(:~
 : Replace the current node.
 :)
declare function xf:replace($replacement as node()*)
    as function(node()*) as node()* {
    function($nodes as node()*) as node()* {
        if (exists($nodes)) then
            $replacement
        else
            $nodes
    }
};

declare function xf:replace($nodes as node()*, $replacement as node()*)
    as node()* {
    xf:replace($replacement)($nodes)
};

(:~
 : Only replace the input nodes when the replacement
 : is not empty.
 :)
declare function xf:replace-if($replacement as node()*)
    as function(node()*) as node()* {
    function($nodes as node()*) as node()* {
        if (exists($replacement) and exists($nodes)) then
            $replacement
        else
            $nodes
    }
};

declare function xf:replace-if($nodes as node()*, $replacement as node()*)
    as node()* {
    xf:replace-if($replacement)($nodes)
};

(:~
 : Inserts nodes before the current node.
 :)
declare function xf:before($before as node()*)
    as function(node()*) as node()* {
    function($nodes as node()*) as node()* {
        ($before, $nodes)
    }
};

declare function xf:before($nodes as node()*, $before as node()*)
    as node()* {
    xf:before($before)($nodes)
};

(:~
 : Inserts nodes after the current node.
 :)
declare function xf:after($after as node()*)
    as function(node()*) as node()* {
    function($nodes as node()*) as node()* {
        ($nodes, $after)
    }
};

declare function xf:after($nodes as node()*, $after as node()*)
    as node()* {
    xf:after($after)($nodes)
};

(:~
 : Inserts nodes as first child, before the current content.
 :)
declare function xf:append($append as node()*)
    as function(node()*) as node()* {
    xf:element-transformer(
        function($node as element()) as element() {
            element { node-name($node) } {
                ($node/(@*,node()), $append)
            }
        }
     (: HACK :)
    )(true())
};

(:~
 : Inserts nodes as last child, after the current content.
 :)
declare function xf:append($nodes as node()*, $append as node()*)
    as node()* {
    xf:append($append)($nodes)
};

(:~
 : Inserts nodes as last child, after the current content.
 :)
declare function xf:prepend($prepend as node()*)
    as function(node()*) as node()* {
    xf:element-transformer(
        function($node as element()) as element() {
            element { node-name($node) } {
                ($node/@*, $prepend, $node/node())
            }
        }
     (: HACK :)
    )(true())
};

(:~
 : Inserts nodes as last child, after the current content.
 :)
declare function xf:prepend($nodes as node()*, $prepend as node()*)
    as node()* {
    xf:prepend($prepend)($nodes)
};

(:~
 : Returns a node transformer that returns a text node with
 : the space normalized string value of a node.
 :)
declare function xf:text()
    as function(node()*) as node()* {
    function($nodes as node()*) as text()? {
        if (exists($nodes)) then
            text { normalize-space(string-join($nodes,'')) }
        else
            ()
    }
};

declare function xf:text($nodes as node()*)
    as text()? {
    xf:text()($nodes)
};

(:~
 : Set attributes using a map.
 :)
declare function xf:set-attr($attributes as item())
    as function(node()*) as node()* {
    let $attributes :=
        typeswitch ($attributes)
        case map(*)
        return
            map:for-each(
                $attributes,
                function($name,$value) {
                    attribute { $name } { $value }
                })
        case element()
        return $attributes/@*
        default
        return
            ()
    return
        xf:element-transformer(
            function($node as element()) as node()* {
                element { node-name($node) } {
                    $attributes,
                    for $att in $node/@*
                    where node-name($att) != $attributes/node-name()
                    return $att,
                    $node/node()
                }
            }
        )($attributes)
};

declare function xf:set-attr($nodes as node()*, $attributes as item())
    as node()* {
    xf:set-attr($attributes)($nodes)
};

(:~
 : Add one or more `$names` to a class attribute.
 :)
declare function xf:add-class($names as xs:string*)
    as function(node()*) as node()* {
    xf:element-transformer(
        function($node as element()) as node()* {
            element { node-name($node) } {
                $node/@*[not(name(.) = 'class')],
                attribute class {
                    string-join(
                        distinct-values(
                            tokenize(
                                string-join(($node/@class,$names),' '),
                                '\s+')),
                        ' ')
                },
                $node/node()
            }
        }
    )($names)
};

(:~
 : Add one or more `$names` to the class attribute of `$element`.
 : If it doesn't exist it is added.
 :)
declare function xf:add-class($nodes as node()*, $names as xs:string*)
    as node()* {
    xf:add-class($names)($nodes)
};

(:~
 : Remove one or more `$names` from the class attribute.
 : If the class attribute is empty after removing names it will be removed
 : from the element.
 :)
declare function xf:remove-class($names as xs:string*)
    as function(node()*) as node()* {
    xf:element-transformer(
        function($node as element()) as node()* {
            element { node-name($node) } {
                $node/@*[not(name(.) =  'class')],
                let $classes := distinct-values(
                    tokenize(($node/@class,'')[1],'\s+')[not(. = $names)])
                where exists($classes)
                return
                    attribute class { string-join($classes,' ') },
                $node/node()
            }
        }
    )($names)
};

(:~
 : Remove one or more `$names` from the class attribute of `$element`.
 : If the class attribute is empty after removing names it will be removed
 : from the element.
 :)
declare function xf:remove-class($nodes as node()*, $names as xs:string*)
    as node()* {
    xf:remove-class($names)($nodes)
};

(:~
 : Remove attributes.
 :)
declare function xf:remove-attr($attributes as item()*)
    as function(node()*) as node()* {
    let $attributes :=
        typeswitch ($attributes)
        case xs:string*
        return for $name in $attributes return attribute { $name } { '' }
        case element()
        return $attributes/@*
        case map(*)
        return
            map:for-each(
                $attributes,
                function($name,$value) {
                    attribute { $name } { '' }
            })
        default
        return ()
    return
        xf:element-transformer(
            function($node as element()) as node()* {
                element { node-name($node) } {
                    for $att in $node/@*
                    where not(node-name($att) = $attributes/node-name())
                    return $att
                }
            }
        )($attributes)
};

declare function xf:remove-attr($nodes as node()*, $names as item()*)
    as node()* {
    xf:remove-attr($names)($nodes)
};

(:~
 : Returns a selector step function that wraps nodes in
 : an element `$element`. An empty sequence will not be
 : wrapped.
 :)
declare function xf:wrap($element as element())
    as function(node()*) as element()? {
    function($nodes as node()*) as element()? {
        if (exists($nodes)) then
            element { node-name($element) } {
                $element/@*,
                $nodes
            }
        else
            ()
    }
};

(:~
 : Wraps `$nodes` in element `$node`. An empty sequence will
 : not be wrapped.
 :)
declare function xf:wrap($nodes as node()*, $element as element())
    as element()? {
    xf:wrap($element)($nodes)
};

(:~
 : Returns a node transformer that removes (unwraps) the
 : outer element of all nodes that are elements. Other nodes
 : are passed through unmodified.
 :
 : This function is safe for use as a node selector.
 :)
declare function xf:unwrap()
    as function(node()*) as node()* {
    xf:element-transformer(
        function($node as element()) as node()* {
            $node/node()
          (: FIXME: passing true() is a bit of a hack, because
             element-transformers check for empty arg even if they
             don't need one :)
        }
    )(true())
};

(:~
 : Unwraps all nodes that are elements.
 :)
declare function xf:unwrap($nodes as node()*)
    as node()* {
    xf:unwrap()($nodes)
};

declare function xf:xslt($stylesheet as item())
    as function(node()*) as node()* {
    xf:xslt($stylesheet, map {})
};

declare function xf:xslt($stylesheet as item(), $params as item())
    as function(node()*) as node()* {
    xf:element-transformer(
        function($node as element()) as node()* {
            xslt:transform($node, $stylesheet, $params)/*
        }
    )($params)
};

declare function xf:xslt($nodes as node()*, $stylesheet as item(), $params as item())
    as node()* {
    xf:xslt($stylesheet, $params)($nodes)
};

(:
 : Creates a generic element node transformer function.
 :)
declare function xf:element-transformer($transform as function(element()) as node()*)
    as function(*) {
    function($args as item()*) as function(*) {
        function($nodes as node()*) as node()* {
            if (exists($args)) then
                for $node in $nodes
                return
                    if ($node instance of element()) then
                        $transform($node)
                    else
                        $node
            else
                $nodes
        }
    }
};

(:~
 : Sets up a default environment which can be customized.
 : Represents the default bindings for selecting nodes.
 : The context is set to $nodes and all it's descendant elements.
 : It also sets up a helper function $in to enable proper checks on tokenized
 : (space-delimited) attribute values such as @class.
 :)
declare function xf:environment() {
    map {
        'bindings': function($nodes as node()*) as map(*) {
            map {
                '': $nodes/descendant-or-self::node(),
                xs:QName('in'): function($att, $token) as xs:boolean {
                    $token = tokenize(string($att),'\s+')
                }
            }
        },
        'query': function($selector as xs:string) {
            'declare variable $in external; ' || $selector
        }
    }
};

declare function xf:expr-environment() {
    map {
        'bindings': function($nodes as node()*) as map(*) {
            map {
                '': $nodes,
                xs:QName('in'): function($att, $token) as xs:boolean {
                    $token = tokenize(string($att),'\s+')
                }
            }
        },
        'query': function($selector as xs:string) {
            'declare variable $in external; ' || $selector
        }
    }
};

(:~
 : Find matches for XPath expression string applied to passed in nodes.
 :)
declare function xf:select-all($selector as xs:string)
    as function(node()*) as node()* {
    xf:select-with-env($selector, xf:environment())
};

declare function xf:select-all($nodes as node()*, $selector as xs:string)
    as function(node()*) as node()* {
    xf:select-all($selector)($nodes)
};

declare function xf:select($selector as xs:string)
    as function(node()*) as node()* {
    xf:select-with-env($selector, xf:expr-environment())
};

declare function xf:select($nodes as node()*, $selector as xs:string)
    as function(node()*) as node()* {
    xf:select($selector)($nodes)
};

declare %private function xf:select-with-env($selector as xs:string, $env as map(*))
    as function(node()*) as node()* {
    let $query := $env('query')($selector)
    let $bindings := $env('bindings')
    return
        function($nodes as node()*) as node()* {
            xquery:eval($query, $bindings($nodes))
        }
};

(:~
 : Copies nodes to output, and calls apply for
 : nodes that are wrapped inside <xf:apply>.
 :)
declare %private function xf:copy-nodes($nodes as node()*, $xform as map(*)*)
    as node()* {
    for $node in $nodes
    return
        if ($node/self::xf:apply) then
            xf:apply-nodes($node, (), $xform)
        else if ($node instance of element()) then
            element { node-name($node) } {
                $node/@*,
                xf:copy-nodes($node/node(), $xform)
            }
        else if ($node instance of document-node()) then
            document {
                xf:copy-nodes($node/node(), $xform)
            }
        else
            $node
};

(:~
 : Applies nodes to output, but runs the template node transformer when it
 : encounters a node that was matched.
 :)
declare %private function xf:apply-nodes($nodes as node()*, $context as map(*)*, $xform as map(*)*)
    as node()* {
    for $node in $nodes
    let $context := (xf:match-templates($node, $xform), $context)
    let $match := xf:matched-template($node, $context)
    return
        if ($node/self::xf:apply) then
            xf:apply-nodes($node/(@*,node()), $context, $xform)
        else if ($match instance of map(*)) then
            xf:copy-nodes($match('fn')($node), $xform)
        else if ($node instance of element()) then
            element { node-name($node) } {
                xf:apply-nodes($node/(@*, node()), $context, $xform)
            }
        else if ($node instance of document-node()) then
            document {
                xf:apply-nodes($node/node(), $context, $xform)
            }
        else
            $node
};

(:~
 : Apply to be used from within templates.
 :)
declare function xf:apply($nodes as node()*)
    as element(xf:apply) {
    <xf:apply>{ $nodes }</xf:apply>
};

(:~
 : Find all templates matched by this node and adds the matched nodes
 : to the templates.
 :)
declare %private function xf:match-templates($node as node(), $xform as map(*)*)
    as map(*)* {
    fold-left(
        $xform,
        (),
        function($matched-templates as map(*)*, $template as map(*)) {
            let $matched-nodes := $template('select')($node)
            return
                if (exists($matched-nodes)) then
                    ($matched-templates, map:new(($template, map { 'nodes': $matched-nodes })))
                else
                    $matched-templates
        }
    )
};

(:~
 : Looks in the $context to find a template that was matched by this
 : node. First one found (most-specific) wins.
 :)
declare %private function xf:matched-template($node as node(), $context as map(*)*)
    as map(*)? {
    if (count($context) gt 0) then
        hof:until(
            function($context as map(*)*) {
                empty($context) or
                xf:is-node-in-sequence($node, head($context)('nodes')) },
            function($context as map(*)*) {
                tail($context) },
            $context
        )[1]
    else
        ()
};

(:~
 : Define a transformation that starts with selecting nodes with an
 : XPath expression.
 :)
declare %private function xf:selector($steps as array(*), $selector-fn as function(*))
    as function(node()*) as node()* {
    (: compile the steps :)
    let $steps :=
        array:fold-left(
            $steps,
            (),
            function($result, $step) {
                if ($step instance of xs:string) then
                    ($result, $selector-fn($step))
                else if ($step instance of function(*)) then
                    ($result, $step)
                else if ($step instance of node()*) then
                    ($result, function($node as node()*) as node()* { $step })
                else if ($step instance of empty-sequence()) then
                    function($node as node()*) as node()* { () }
                else
                    ($result, text { $step })
            }
        )
    return
        function($nodes as node()*) as node()* {
            for $selected in head($steps)($nodes)
            return
                fold-left(
                    tail($steps),
                    $selected,
                    function($result, $step) {
                        $step($result)
                    }
                )
        }
};

declare %private function xf:comp-expression($expressions as item()*)
    as (function(node()*) as node()*)* {
    for $expression in $expressions
    return
        if ($expression instance of xs:string) then
            xf:select($expression)
        else
            $expression
};

(:~
 : Returns `true()` if the node `$node` is also in sequence `$seq`.
 :
 : @see http://www.xqueryfunctions.com/xq/functx_is-node-in-sequence.html
 :)
declare %private function xf:is-node-in-sequence($node as node()?, $seq as node()*)
    as xs:boolean {
    some $nodeInSeq in $seq satisfies $nodeInSeq is $node
};

xquery version "3.0";

(:~
 : Origami templating.
 :
 : Requires Basex 8.0 20141221 or later.
 :
 : @version 0.4
 : @author Marc van Grootel
 : @see https://github.com/xokomola/origami
 :)

module namespace xf = 'http://xokomola.com/xquery/origami';

(:~
 : Load an HTML resource.
 :)
declare function xf:html-resource($url-or-path) {
    if (starts-with($url-or-path,'http:/')) then
        xf:fetch-html($url-or-path)
    else
        xf:parse-html($url-or-path)
};

(:~
 : Load an XML resource.
 :)
declare function xf:xml-resource($url-or-path) {
    doc($url-or-path)
};

(:~
 : Fetch and parse HTML given a URL.
 :)
declare function xf:fetch-html($url) {
    html:parse(fetch:binary($url))
};

(:~
 : Parse HTML from a filesystem path.
 :)
declare function xf:parse-html($path) {
    html:parse(file:read-binary($path))
};

(:~
 : Returns a Transformer function.
 :)
declare function xf:transform($templates as array(*)*)
    as function(node()*) as node()* {
    let $templates :=
        for $template in $templates
        return xf:match($template)
    return
        function($nodes as node()*) as node()* {
            xf:apply-nodes($nodes, (), $templates)
        }
};

(:~
 : Transform input, using the specified templates.
 :)
declare function xf:transform($nodes as node()*, $templates as array(*)*)
    as node()* {
    xf:transform($templates)($nodes)
};

(:~
 : Identity transformer.
 :)
declare function xf:transform() { xf:transform(()) };

(:~
 : Returns an extractor function that only returns selected nodes
 : only outermost, in document order and duplicates eliminated.
 :)
declare function xf:extract($selectors as array(*)*)
    as function(node()*) as node()* {
    xf:extract-outer($selectors)
};

(:~
 : Extracts nodes from input, using the specified selectors.
 :)
declare function xf:extract($nodes as node()*, $selectors as array(*)*)
    as node()* {
    xf:extract($selectors)($nodes)
};

(:~
 : Returns an extractor function that returns selected nodes,
 : only innermost, in document order and duplicates eliminitated.
 :)
declare function xf:extract-inner($selectors as array(*)*)
    as function(node()*) as node()* {
    let $selectors :=
        for $selector in $selectors
        return
            xf:at($selector)
    return
        function($nodes as node()*) as node()* {
            innermost(
                for $selector in $selectors
                return $selector($nodes)
            )
        }
};

declare function xf:extract-inner($nodes as node()*, $selectors as array(*)*)
    as node()* {
    xf:extract-inner($selectors)($nodes)
};

(:~
 : Returns an extractor function that returns selected nodes,
 : only outermost, in document order and duplicates eliminated.
 :)
declare function xf:extract-outer($selectors as array(*)*)
    as function(node()*) as node()* {
    let $selectors :=
        for $selector in $selectors
        return xf:at($selector)
    return
        function($nodes as node()*) as node()* {
            outermost(
                for $selector in $selectors
                return $selector($nodes)
            )
        }
};

declare function xf:extract-outer($nodes as node()*, $selectors as array(*)*)
    as node()* {
    xf:extract-outer($selectors)($nodes)
};

(:~
 : Defines a match template.
 :
 : A template takes a selector string or function and
 : a node transformation function or the items to return as
 : the template body.
 : Providing invalid matcher returns empty sequence.
 :)
declare function xf:match($template as array(*))
    as map(*)? {
    let $selector := xf:selector([array:head($template)], xf:select#1)
    let $body := xf:do(array:tail($template))
    where array:size($template) gt 0
    return
        map {
            'select': $selector,
            'fn': $body
        }
};

declare function xf:at($steps as array(*))
    as function(node()*) as node()* {
    xf:selector($steps, xf:select-all#1)
};
(:~
 : Execute a chain of node selectors.
 :)
declare function xf:at($nodes as node()*, $selector as item()*) {
    xf:at($selector)($nodes)
};

declare %private function xf:selector($steps as array(*))
    as function(node()*) as node()* {
    xf:selector($steps, xf:select-all#1)
};
(:~
 : Only nodes for which the chain of expressions evaluates to `true()`
 : are passed through.
 :)
declare function xf:if($conditions as item()*)
    as function(node()*) as node()* {
    let $conditions := xf:comp-expression($conditions)
    return
        function($nodes as node()*) as node()* {
            fold-left(
                $conditions,
                $nodes,
                function($result, $step) {
                    if ($step($result)) then
                       $result
                    else
                        ()
                }
            )
        }
};

(:~
 : Filter nodes based on evaluating a chain of expressions, letting only
 : those nodes through for which it returns `true()`.
 :)
declare function xf:if($nodes as node()*, $conditions as item()*)
    as node()* {
    xf:if($conditions)($nodes)
};

(:~
 : Compose a chain of node transformers.
 :)
declare function xf:do($fns as array(*))
    as function(node()*) as node()* {
    function($nodes as node()*) as node()* {
        array:fold-left(
            $fns,
            $nodes,
            function($nodes, $fn) {
                if (exists($fn)) then
                    $fn($nodes)
                else
                    ()
            }
        )
    }
};

(:~
 : Execute a chain of node transformers.
 :)
declare function xf:do($nodes as node()*, $fns as array(*))
    as node()* {
    xf:do($fns)($nodes)
};

(:~
 : Replace the content (child nodes) of the input node
 :)
declare function xf:content($content as node()*)
    as function(element()?) as element()? {
    function($element as element()?) as element()? {
        if (exists($element)) then
            element { node-name($element) } {
                $element/@*,
                $content
            }
        else
            $element
    }
};

declare function xf:content($element as element()?, $content as node()*)
    as element()? {
    xf:content($content)($element)
};

(:~
 : Only replace the content of the input element when
 : the content is not empty.
 :)
declare function xf:content-if($content as node()*)
    as function(element()?) as element()? {
    function($element as element()?) as element()? {
        if (exists($content) and exists($element)) then
            element { node-name($element) } {
                $element/@*,
                $content
            }
        else
            $element
    }
};

declare function xf:content-if($element as element()?, $content as node()*)
    as element()? {
    xf:content-if($content)($element)
};

(:~
 : Replace the current node.
 :)
declare function xf:replace($replacement as node()*)
    as function(node()*) as node()* {
    function($nodes as node()*) as node()* {
        if (exists($nodes)) then
            $replacement
        else
            $nodes
    }
};

declare function xf:replace($nodes as node()*, $replacement as node()*)
    as node()* {
    xf:replace($replacement)($nodes)
};

(:~
 : Only replace the input nodes when the replacement
 : is not empty.
 :)
declare function xf:replace-if($replacement as node()*)
    as function(node()*) as node()* {
    function($nodes as node()*) as node()* {
        if (exists($replacement) and exists($nodes)) then
            $replacement
        else
            $nodes
    }
};

declare function xf:replace-if($nodes as node()*, $replacement as node()*)
    as node()* {
    xf:replace-if($replacement)($nodes)
};

(:~
 : Inserts nodes before the current node.
 :)
declare function xf:before($before as node()*)
    as function(node()*) as node()* {
    function($nodes as node()*) as node()* {
        ($before, $nodes)
    }
};

declare function xf:before($nodes as node()*, $before as node()*)
    as node()* {
    xf:before($before)($nodes)
};

(:~
 : Inserts nodes after the current node.
 :)
declare function xf:after($after as node()*)
    as function(node()*) as node()* {
    function($nodes as node()*) as node()* {
        ($nodes, $after)
    }
};

declare function xf:after($nodes as node()*, $after as node()*)
    as node()* {
    xf:after($after)($nodes)
};

(:~
 : Inserts nodes as first child, before the current content.
 :)
declare function xf:append($append as node()*)
    as function(node()*) as node()* {
    xf:element-transformer(
        function($node as element()) as element() {
            element { node-name($node) } {
                ($node/(@*,node()), $append)
            }
        }
     (: HACK :)
    )(true())
};

(:~
 : Inserts nodes as last child, after the current content.
 :)
declare function xf:append($nodes as node()*, $append as node()*)
    as node()* {
    xf:append($append)($nodes)
};

(:~
 : Inserts nodes as last child, after the current content.
 :)
declare function xf:prepend($prepend as node()*)
    as function(node()*) as node()* {
    xf:element-transformer(
        function($node as element()) as element() {
            element { node-name($node) } {
                ($node/@*, $prepend, $node/node())
            }
        }
     (: HACK :)
    )(true())
};

(:~
 : Inserts nodes as last child, after the current content.
 :)
declare function xf:prepend($nodes as node()*, $prepend as node()*)
    as node()* {
    xf:prepend($prepend)($nodes)
};

(:~
 : Returns a node transformer that returns a text node with
 : the space normalized string value of a node.
 :)
declare function xf:text()
    as function(node()*) as node()* {
    function($nodes as node()*) as text()? {
        if (exists($nodes)) then
            text { normalize-space(string-join($nodes,'')) }
        else
            ()
    }
};

declare function xf:text($nodes as node()*)
    as text()? {
    xf:text()($nodes)
};

(:~
 : Set attributes using a map.
 :)
declare function xf:set-attr($attributes as item())
    as function(node()*) as node()* {
    let $attributes :=
        typeswitch ($attributes)
        case map(*)
        return
            map:for-each(
                $attributes,
                function($name,$value) {
                    attribute { $name } { $value }
                })
        case element()
        return $attributes/@*
        default
        return
            ()
    return
        xf:element-transformer(
            function($node as element()) as node()* {
                element { node-name($node) } {
                    $attributes,
                    for $att in $node/@*
                    where node-name($att) != $attributes/node-name()
                    return $att,
                    $node/node()
                }
            }
        )($attributes)
};

declare function xf:set-attr($nodes as node()*, $attributes as item())
    as node()* {
    xf:set-attr($attributes)($nodes)
};

(:~
 : Add one or more `$names` to a class attribute.
 :)
declare function xf:add-class($names as xs:string*)
    as function(node()*) as node()* {
    xf:element-transformer(
        function($node as element()) as node()* {
            element { node-name($node) } {
                $node/@*[not(name(.) = 'class')],
                attribute class {
                    string-join(
                        distinct-values(
                            tokenize(
                                string-join(($node/@class,$names),' '),
                                '\s+')),
                        ' ')
                },
                $node/node()
            }
        }
    )($names)
};

(:~
 : Add one or more `$names` to the class attribute of `$element`.
 : If it doesn't exist it is added.
 :)
declare function xf:add-class($nodes as node()*, $names as xs:string*)
    as node()* {
    xf:add-class($names)($nodes)
};

(:~
 : Remove one or more `$names` from the class attribute.
 : If the class attribute is empty after removing names it will be removed
 : from the element.
 :)
declare function xf:remove-class($names as xs:string*)
    as function(node()*) as node()* {
    xf:element-transformer(
        function($node as element()) as node()* {
            element { node-name($node) } {
                $node/@*[not(name(.) =  'class')],
                let $classes := distinct-values(
                    tokenize(($node/@class,'')[1],'\s+')[not(. = $names)])
                where exists($classes)
                return
                    attribute class { string-join($classes,' ') },
                $node/node()
            }
        }
    )($names)
};

(:~
 : Remove one or more `$names` from the class attribute of `$element`.
 : If the class attribute is empty after removing names it will be removed
 : from the element.
 :)
declare function xf:remove-class($nodes as node()*, $names as xs:string*)
    as node()* {
    xf:remove-class($names)($nodes)
};

(:~
 : Remove attributes.
 :)
declare function xf:remove-attr($attributes as item()*)
    as function(node()*) as node()* {
    let $attributes :=
        typeswitch ($attributes)
        case xs:string*
        return for $name in $attributes return attribute { $name } { '' }
        case element()
        return $attributes/@*
        case map(*)
        return
            map:for-each(
                $attributes,
                function($name,$value) {
                    attribute { $name } { '' }
            })
        default
        return ()
    return
        xf:element-transformer(
            function($node as element()) as node()* {
                element { node-name($node) } {
                    for $att in $node/@*
                    where not(node-name($att) = $attributes/node-name())
                    return $att
                }
            }
        )($attributes)
};

declare function xf:remove-attr($nodes as node()*, $names as item()*)
    as node()* {
    xf:remove-attr($names)($nodes)
};

(:~
 : Returns a selector step function that wraps nodes in
 : an element `$element`. An empty sequence will not be
 : wrapped.
 :)
declare function xf:wrap($element as element())
    as function(node()*) as element()? {
    function($nodes as node()*) as element()? {
        if (exists($nodes)) then
            element { node-name($element) } {
                $element/@*,
                $nodes
            }
        else
            ()
    }
};

(:~
 : Wraps `$nodes` in element `$node`. An empty sequence will
 : not be wrapped.
 :)
declare function xf:wrap($nodes as node()*, $element as element())
    as element()? {
    xf:wrap($element)($nodes)
};

(:~
 : Returns a node transformer that removes (unwraps) the
 : outer element of all nodes that are elements. Other nodes
 : are passed through unmodified.
 :
 : This function is safe for use as a node selector.
 :)
declare function xf:unwrap()
    as function(node()*) as node()* {
    xf:element-transformer(
        function($node as element()) as node()* {
            $node/node()
          (: FIXME: passing true() is a bit of a hack, because
             element-transformers check for empty arg even if they
             don't need one :)
        }
    )(true())
};

(:~
 : Unwraps all nodes that are elements.
 :)
declare function xf:unwrap($nodes as node()*)
    as node()* {
    xf:unwrap()($nodes)
};

declare function xf:xslt($stylesheet as item())
    as function(node()*) as node()* {
    xf:xslt($stylesheet, map {})
};

declare function xf:xslt($stylesheet as item(), $params as item())
    as function(node()*) as node()* {
    xf:element-transformer(
        function($node as element()) as node()* {
            xslt:transform($node, $stylesheet, $params)/*
        }
    )($params)
};

declare function xf:xslt($nodes as node()*, $stylesheet as item(), $params as item())
    as node()* {
    xf:xslt($stylesheet, $params)($nodes)
};

(:
 : Creates a generic element node transformer function.
 :)
declare function xf:element-transformer($transform as function(element()) as node()*)
    as function(*) {
    function($args as item()*) as function(*) {
        function($nodes as node()*) as node()* {
            if (exists($args)) then
                for $node in $nodes
                return
                    if ($node instance of element()) then
                        $transform($node)
                    else
                        $node
            else
                $nodes
        }
    }
};

(:~
 : Sets up a default environment which can be customized.
 : Represents the default bindings for selecting nodes.
 : The context is set to $nodes and all it's descendant elements.
 : It also sets up a helper function $in to enable proper checks on tokenized
 : (space-delimited) attribute values such as @class.
 :)
declare function xf:environment() {
    map {
        'bindings': function($nodes as node()*) as map(*) {
            map {
                '': $nodes/descendant-or-self::node(),
                xs:QName('in'): function($att, $token) as xs:boolean {
                    $token = tokenize(string($att),'\s+')
                }
            }
        },
        'query': function($selector as xs:string) {
            'declare variable $in external; ' || $selector
        }
    }
};

declare function xf:expr-environment() {
    map {
        'bindings': function($nodes as node()*) as map(*) {
            map {
                '': $nodes,
                xs:QName('in'): function($att, $token) as xs:boolean {
                    $token = tokenize(string($att),'\s+')
                }
            }
        },
        'query': function($selector as xs:string) {
            'declare variable $in external; ' || $selector
        }
    }
};

(:~
 : Find matches for XPath expression string applied to passed in nodes.
 :)
declare function xf:select-all($selector as xs:string)
    as function(node()*) as node()* {
    xf:select-with-env($selector, xf:environment())
};

declare function xf:select-all($nodes as node()*, $selector as xs:string)
    as function(node()*) as node()* {
    xf:select-all($selector)($nodes)
};

declare function xf:select($selector as xs:string)
    as function(node()*) as node()* {
    xf:select-with-env($selector, xf:expr-environment())
};

declare function xf:select($nodes as node()*, $selector as xs:string)
    as function(node()*) as node()* {
    xf:select($selector)($nodes)
};

declare %private function xf:select-with-env($selector as xs:string, $env as map(*))
    as function(node()*) as node()* {
    let $query := $env('query')($selector)
    let $bindings := $env('bindings')
    return
        function($nodes as node()*) as node()* {
            xquery:eval($query, $bindings($nodes))
        }
};

(:~
 : Copies nodes to output, and calls apply for
 : nodes that are wrapped inside <xf:apply>.
 :)
declare %private function xf:copy-nodes($nodes as node()*, $xform as map(*)*)
    as node()* {
    for $node in $nodes
    return
        if ($node/self::xf:apply) then
            xf:apply-nodes($node, (), $xform)
        else if ($node instance of element()) then
            element { node-name($node) } {
                $node/@*,
                xf:copy-nodes($node/node(), $xform)
            }
        else if ($node instance of document-node()) then
            document {
                xf:copy-nodes($node/node(), $xform)
            }
        else
            $node
};

(:~
 : Applies nodes to output, but runs the template node transformer when it
 : encounters a node that was matched.
 :)
declare %private function xf:apply-nodes($nodes as node()*, $context as map(*)*, $xform as map(*)*)
    as node()* {
    for $node in $nodes
    let $context := (xf:match-templates($node, $xform), $context)
    let $match := xf:matched-template($node, $context)
    return
        if ($node/self::xf:apply) then
            xf:apply-nodes($node/(@*,node()), $context, $xform)
        else if ($match instance of map(*)) then
            xf:copy-nodes($match('fn')($node), $xform)
        else if ($node instance of element()) then
            element { node-name($node) } {
                xf:apply-nodes($node/(@*, node()), $context, $xform)
            }
        else if ($node instance of document-node()) then
            document {
                xf:apply-nodes($node/node(), $context, $xform)
            }
        else
            $node
};

(:~
 : Apply to be used from within templates.
 :)
declare function xf:apply($nodes as node()*)
    as element(xf:apply) {
    <xf:apply>{ $nodes }</xf:apply>
};

(:~
 : Find all templates matched by this node and adds the matched nodes
 : to the templates.
 :)
declare %private function xf:match-templates($node as node(), $xform as map(*)*)
    as map(*)* {
    fold-left(
        $xform,
        (),
        function($matched-templates as map(*)*, $template as map(*)) {
            let $matched-nodes := $template('select')($node)
            return
                if (exists($matched-nodes)) then
                    ($matched-templates, map:new(($template, map { 'nodes': $matched-nodes })))
                else
                    $matched-templates
        }
    )
};

(:~
 : Looks in the $context to find a template that was matched by this
 : node. First one found (most-specific) wins.
 :)
declare %private function xf:matched-template($node as node(), $context as map(*)*)
    as map(*)? {
    if (count($context) gt 0) then
        hof:until(
            function($context as map(*)*) {
                empty($context) or
                xf:is-node-in-sequence($node, head($context)('nodes')) },
            function($context as map(*)*) {
                tail($context) },
            $context
        )[1]
    else
        ()
};

(:~
 : Define a transformation that starts with selecting nodes with an
 : XPath expression.
 :)
declare %private function xf:selector($steps as array(*), $selector-fn as function(*))
    as function(node()*) as node()* {
    (: compile the steps :)
    let $steps :=
        array:fold-left(
            $steps,
            (),
            function($result, $step) {
                if ($step instance of xs:string) then
                    ($result, $selector-fn($step))
                else if ($step instance of function(*)) then
                    ($result, $step)
                else if ($step instance of node()*) then
                    ($result, function($node as node()*) as node()* { $step })
                else if ($step instance of empty-sequence()) then
                    function($node as node()*) as node()* { () }
                else
                    ($result, text { $step })
            }
        )
    return
        function($nodes as node()*) as node()* {
            for $selected in head($steps)($nodes)
            return
                fold-left(
                    tail($steps),
                    $selected,
                    function($result, $step) {
                        $step($result)
                    }
                )
        }
};

declare %private function xf:comp-expression($expressions as item()*)
    as (function(node()*) as node()*)* {
    for $expression in $expressions
    return
        if ($expression instance of xs:string) then
            xf:select($expression)
        else
            $expression
};

(:~
 : Returns `true()` if the node `$node` is also in sequence `$seq`.
 :
 : @see http://www.xqueryfunctions.com/xq/functx_is-node-in-sequence.html
 :)
declare %private function xf:is-node-in-sequence($node as node()?, $seq as node()*)
    as xs:boolean {
    some $nodeInSeq in $seq satisfies $nodeInSeq is $node
};


Make the X-Derived and X-Content-Type headers configurable to make it easier to test.

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

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

declare namespace o = "http://reecedunn.co.uk/xquery/options";
declare option o:implementation "marklogic/6.0";

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

declare variable $mode as xs:string external := "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:item($path as xs:string, $value as xs:string, $type as xs:string) {
    if (string-length($value) ne 0) then
        xdmp:unquote($value)
    else if (string-length($path) ne 0) then
        doc($path)
    else
        ()
};

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

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

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

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

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

declare function local:eval-options() {
    let $server := local:nullize($server) ! xdmp:server(.)
    let $database := local:nullize($database) ! xdmp:database(.)
    return <options xmlns="xdmp:eval">{
        if ($mode eq "validate") then
            <static-check>true</static-check>
        else
            (),
        if (exists($database)) then
            <database>{$database}</database>
        else
            (),
        if (exists($server)) then
            <default-collation>{xdmp:server-collation($server)}</default-collation>
        else
            (),
        let $server-coordinate-system := local:function("xdmp:server-coordinate-system#1")
        return if (exists($server) and exists($server-coordinate-system)) then
            <default-coordinate-system>{$server-coordinate-system($server)}</default-coordinate-system>
        else
            (),
        if (exists($server) and $mimetype eq "application/xquery") then
            <default-xquery-version>{xdmp:server-default-xquery-version($server)}</default-xquery-version>
        else
            (),
        if (exists($server)) then
            <modules>{xdmp:server-modules-database($server)}</modules>
        else if (string-length($module-root) ne 0) then
            <modules>0</modules> (: file system :)
        else
            (),
        if (exists($server) or string-length($module-root) ne 0) then
            <root>{(local:nullize($module-root), xdmp:server-root($server))[1]}</root>
        else
            (),
        let $major := local:version()
        let $minor := local:version-minor()
        return if ($mode = "debug") then
            if ($updating = "true") 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 ($updating = "true") then
                <transaction-mode>update</transaction-mode>
            else
                <transaction-mode>query</transaction-mode>
        else
            (: MarkLogic 8.0-7 and 9.0-2 support <update> :)
            <update>{$updating}</update>
    }</options>
};

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

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

declare namespace o = "http://reecedunn.co.uk/xquery/options";
declare option o:implementation "marklogic/6.0";

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

declare variable $mode as xs:string external := "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 function local:nullize($value) {
    if (string-length($value) eq 0) then () else $value
};

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

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

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

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

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

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

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

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

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

declare function local:eval-options() {
    let $server := local:nullize($server) ! xdmp:server(.)
    let $database := local:nullize($database) ! xdmp:database(.)
    return <options xmlns="xdmp:eval">{
        if ($mode eq "validate") then
            <static-check>true</static-check>
        else
            (),
        if (exists($database)) then
            <database>{$database}</database>
        else
            (),
        if (exists($server)) then
            <default-collation>{xdmp:server-collation($server)}</default-collation>
        else
            (),
        let $server-coordinate-system := local:function("xdmp:server-coordinate-system#1")
        return if (exists($server) and exists($server-coordinate-system)) then
            <default-coordinate-system>{$server-coordinate-system($server)}</default-coordinate-system>
        else
            (),
        if (exists($server) and $mimetype eq "application/xquery") then
            <default-xquery-version>{xdmp:server-default-xquery-version($server)}</default-xquery-version>
        else
            (),
        if (exists($server)) then
            <modules>{xdmp:server-modules-database($server)}</modules>
        else if (string-length($module-root) ne 0) then
            <modules>0</modules> (: file system :)
        else
            (),
        if (exists($server) or string-length($module-root) ne 0) then
            <root>{(local:nullize($module-root), xdmp:server-root($server))[1]}</root>
        else
            (),
        let $major := local:version()
        let $minor := local:version-minor()
        return if ($mode = "debug") then
            if ($updating = "true") 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 ($updating = "true") then
                <transaction-mode>update</transaction-mode>
            else
                <transaction-mode>query</transaction-mode>
        else
            (: MarkLogic 8.0-7 and 9.0-2 support <update> :)
            <update>{$updating}</update>
    }</options>
};

declare function local: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("X-Content-Type-" || (count($retvals) + 1), $rdf-output-format)
        return (
            for $retval at $i in $retvals
            let $_ := local:derived-type-name($retval) ! xdmp:add-response-header("X-Derived-" || $i, .)
            return $retval,
            $rdf-output
        )
    else
        for $retval at $i in ($retvals, $triples)
        let $_ := local:derived-type-name($retval) ! xdmp:add-response-header("X-Derived-" || $i, .)
        return $retval
} catch * {
    let $_ := xdmp:add-response-header("X-Derived-1", "err:error")
    return $err:additional
}