test refactoring

test refactoring

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)
};

(:~
 : Load a plain text resource.
 :)
declare function xf:text-resource($url-or-path) {
    unparsed-text($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 function.
 :)
declare function xf:template($template as item()*, $selector as array(*)?, $model as item()*)
    as function(*) {
    let $at := if ($selector instance of array(*)) then xf:at($selector) else function($nodes) { $nodes }
    return
        typeswitch ($model)
        (: test array first because it is also a function :)
        case array(*)*
        return
            function() as item()* {
                $template => $at() => xf:transform($model)
            }
        case function(*)
        return
            switch (function-arity($model))
            case 0
            return
                function() as item()* {
                    $template => $at() => xf:transform($model)
                }
            case 1
            return
                function($arg1 as item()?) as item()* {
                    $template => $at() => xf:transform(apply($model, [$arg1]))
                }
            case 2
            return
                function($arg1 as item()?, $arg2 as item()?) as item()* {
                    $template => $at() => xf:transform(apply($model, [$arg1, $arg2]))
                }
            case 3
            return
                function($arg1 as item()?, $arg2 as item()?, $arg3 as item()?) as item()* {
                    $template => $at() => xf:transform(apply($model, [$arg1, $arg2, $arg3]))
                }
            (: max arity-4 supported :)
            case 4
            return
                function($arg1 as item()?, $arg2 as item()?, $arg3 as item()?, $arg4 as item()?) as item()* {
                    $template => $at() => xf:transform(apply($model, [$arg1, $arg2, $arg3, $arg4]))
                }
            default
            return
                error(xf:ArityNotSupportedError, 'A model function cannot have more than 4 arguments')

        case empty-sequence()
        return
            function() as item()* {
                $template => $at()
            }
        default
        return
            error(xf:InvalidModelError, 'This model cannot be used')
};

(:~
 : Apply `$template` to template function.
 :)
declare function xf:template($template as item(), $model as item()*)
    as function(*) {
    xf:template($template, (), $model)
};

(:~
 : Template identity transform.
 :)
declare function xf:template($template as item())
    as function(*) {
    xf:template($template, (), ())
};

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

(:~
 : Transform input, using the specified rules.
 :)
declare function xf:transform($nodes as item()*, $rules as array(*)*)
    as item()* {
    xf:transform($rules)($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($rules as array(*)*)
    as function(item()*) as item()* {
    xf:extract-outer($rules)
};

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

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

(:~
 : Apply extractor rules to `$nodes` and return the innermost nodes.
 :)
declare function xf:extract-inner($nodes as item()*, $rules as array(*)*)
    as item()* {
    xf:extract-inner($rules)($nodes)
};

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

(:~
 : Apply extractor rules to `$nodes` and return the outermost nodes.
 :)
declare function xf:extract-outer($nodes as item()*, $rules as array(*)*)
    as item()* {
    xf:extract-outer($rules)($nodes)
};

(:~
 : Create a match function from a rule.
 :)
declare function xf:match($rule as array(*))
    as map(*)? {
    let $select := xf:selector([array:head($rule)], xf:select#1)
    let $body := xf:do(array:tail($rule))
    where array:size($rule) gt 0
    return
        map {
            'select': $select,
            'fn': $body
        }
};

(:~
 : Create a selector function from a rule.
 :)
declare function xf:at($rule as array(*))
    as function(item()*) as item()* {
    xf:selector($rule, xf:select-all#1)
};

(:~
 : Apply a transformation rule to input nodes.
 :)
declare function xf:at($nodes as item()*, $rule as array(*))
    as item()* {
    xf:at($rule)($nodes)
};

(:~
 : Create a node transformer that applies a node transformation rule to a
 : sequence of input nodes.
 :)
declare function xf:do($rule as array(*))
    as function(item()*) as item()* {
    function($nodes as item()*) as item()* {
        xf:do-nodes($nodes, $rule)
    }
};

(:~
 : Apply a node transformation rule to a sequence of nodes.
 :)
declare function xf:do($nodes as item()*, $rule as array(*))
    as item()* {
    xf:do-nodes($nodes, $rule)
};

(:~
 : Create a node transformer that applies a node transformation rule to each
 : individual input node.
 :)
declare function xf:each($rule as array(*))
    as function(item()*) as item()* {
    function($nodes as item()*) as item()* {
        for $node in $nodes
            return xf:do-nodes($node, $rule)
    }
};

(:~
 : Apply a node transformation rule to each individual input node.
 :)
declare function xf:each($nodes as item()*, $rule as array(*))
    as item()* {
    for $node in $nodes
        return xf:do-nodes($node, $rule)
};

declare %private function xf:do-nodes($nodes as item()*, $rule as array(*))
    as item()* {
    array:fold-left(
        $rule,
        $nodes,
        function($nodes, $step) {
            if ($step instance of function(*)) then
                $step($nodes)
            else
                $step
        }
    )
};

(:~
 : Only nodes for which the chain of expressions evaluates to `true()`
 : are passed through.
 :)
declare function xf:if($conditions as item()*)
    as function(item()*) as item()* {
    let $conditions := xf:comp-expression($conditions)
    return
        function($nodes as item()*) as item()* {
            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 item()*, $conditions as item()*)
    as item()* {
    xf:if($conditions)($nodes)
};

(:~
 : Create a node transformer that replaces the child nodes of an
 : element with `$content`.
 :)
declare function xf:content($content as item()*)
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            element { node-name($node) } {
                $node/@*,
                $content
            }
        }
     (: HACK :)
    )(true())
};

(:~
 : Replace the child nodes of `$element` with `$content`.
 :)
declare function xf:content($nodes as item()*, $content as item()*)
    as item()* {
    xf:content($content)($nodes)
};

(:~
 : Create a node transformer that replaces the nodes passed with
 : `$replacement`.
 :)
declare function xf:replace($replacement as item()*)
    as function(item()*) as item()* {
    function($nodes as item()*) as item()* {
        if (exists($nodes)) then
            $replacement
        else
            $nodes
    }
};

(:~
 : Replace `$nodes` with `$replacement`.
 :)
declare function xf:replace($nodes as item()*, $replacement as item()*)
    as item()* {
    xf:replace($replacement)($nodes)
};

(:~
 : Create a node transformer that inserts `$before` before
 : the nodes passed in.
 :)
declare function xf:before($before as item()*)
    as function(item()*) as item()* {
    function($nodes as item()*) as item()* {
        ($before, $nodes)
    }
};

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

(:~
 : Create a node transformer that inserts `$after` after
 : the nodes passed in.
 :)
declare function xf:after($after as item()*)
    as function(item()*) as item()* {
    function($nodes as item()*) as item()* {
        ($nodes, $after)
    }
};

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

(:~
 : Create a node transformer that appends `$append` nodes
 : to the child nodes of each element of `$nodes`.
 :)
declare function xf:append($append as item()*)
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            element { node-name($node) } {
                $node/(@*,node()),
                $append
            }
        }
     (: HACK :)
    )(true())
};

(:~
 : Inserts `$append` nodes to the child nodes of each element in
 : `$nodes`.
 :)
declare function xf:append($nodes as item()*, $append as item()*)
    as item()* {
    xf:append($append)($nodes)
};

(:~
 : Create a node transformer that prepends `$prepend` nodes
 : to the child nodes of each element of `$nodes`.
 :)
declare function xf:prepend($prepend as item()*)
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            element { node-name($node) } {
                ($node/@*, $prepend, $node/node())
            }
        }
     (: HACK :)
    )(true())
};

(:~
 : Inserts `$prepend` nodes before the first child node of each element
 : in `$nodes`.
 :)
declare function xf:prepend($nodes as item()*, $prepend as item()*)
    as item()* {
    xf:prepend($prepend)($nodes)
};

(:~
 : Create a node transformer that returns a text node with
 : the space normalized string value of a node.
 :)
declare function xf:text()
    as function(item()*) as item()* {
    function($nodes as item()*) as item()* {
        if (exists($nodes)) then
            for $node in $nodes
                return
                    typeswitch ($node)
                    case map(*)
                    return
                        $node
                    case array(*)
                    return
                        $node
                    case function(*)
                    return
                        $node
                    default
                    return
                        text { string($node) }
        else
            ()
    }
};

(:~
 : Outputs the text value of `$nodes`.
 :)
declare function xf:text($nodes as item()*)
    as item()* {
    xf:text()($nodes)
};

(:~
 : Create a node transformer that sets attributes using a map
 : on each element in the nodes passed.
 :
 : Map keys must be valid as QNames or they will be ignored.
 :)
declare function xf:set-attr($attributes as item())
    as function(item()*) as item()* {
    let $attributes :=
        typeswitch ($attributes)
        case map(*)
            return
                map:for-each(
                    $attributes,
                    function($name, $value) {
                        if ($name castable as xs:QName) then
                            attribute { $name } { $value }
                        else
                            ()
                    }
                )
        case element()
            return $attributes/@*
        default
            return ()
    return
        xf:element-transformer(
            function($node as element()) as element() {
                element { node-name($node) } {
                    $attributes,
                    for $att in $node/@*
                        where node-name($att) != $attributes/node-name()
                        return $att,
                    $node/node()
                }
            }
        )($attributes)
};

(:~
 : Set attributes using a map on each element in `$nodes`.
 :)
declare function xf:set-attr($nodes as item()*, $attributes as item())
    as item()* {
    xf:set-attr($attributes)($nodes)
};

(:~
 : Create a node transformer that adds one or more class names to
 : each element in the nodes passed.
 :)
declare function xf:add-class($names as xs:string*)
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            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 item()*, $names as xs:string*)
    as item()* {
    xf:add-class($names)($nodes)
};

(:~
 : Create a node transformer that removes 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(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            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 item()*, $names as xs:string*)
    as item()* {
    xf:remove-class($names)($nodes)
};

(:~
 : Create a node transformer that remove attributes.
 :
 : If a name cannot be used as an attribute name (xs:QName) then
 : it will be silently ignored.
 :)
declare function xf:remove-attr($attributes as item()*)
    as function(item()*) as item()* {
    let $names :=
        typeswitch ($attributes)
        case xs:string*
            return
                for $name in $attributes
                return
                    if ($name eq '*') then
                        '*'
                    else if ($name castable as xs:QName) then
                        attribute { $name } { '' }
                    else
                        ()
        case element()
            return $attributes/@*
        case map(*)
            return
                map:for-each(
                    $attributes,
                    function($name,$value) {
                    if ($name castable as xs:QName) then
                        attribute { $name } { '' }
                    else
                        ()
                })
        default
            return ()
    return
        xf:element-transformer(
            function($node as element()) as element() {
                element { node-name($node) } {
                    for $att in $node/@*
                        where not($names = '*') and
                              not(node-name($att) = $names/node-name())
                        return $att
                }
            }
        )($attributes)
};

(:~
 : Remove attributes from each element in `$nodes`.
 :)
declare function xf:remove-attr($nodes as item()*, $names as item()*)
    as item()* {
    xf:remove-attr($names)($nodes)
};

(:~
 : Create a node-transformer that renames element nodes, passing non-element
 : nodes and element child nodes through unmodified.
 :
 : Renaming can be done using a:
 :
 : - `xs:string`: renames all elements
 : - `map(*)`: looks up the element name in the map and uses the value as the
 :   new name
 : - `function($node as element()) as item()`: passes the element node to the
 :   function using the return value as the new element name
 :)
declare function xf:rename($map as item())
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            typeswitch ($map)
            case map(*)
                return
                    if ($map(node-name($node))) then
                        element { $map(node-name($node)) } {
                            $node/(@*,node())
                        }
                    else if ($map(name($node))) then
                        element { $map(name($node)) } {
                            $node/(@*,node())
                        }
                    else
                        $node
             case function(*)
                 return
                    element { $map($node) } {
                        $node/(@*,node())
                    }
             case xs:string
                 return
                    element { $map } {
                        $node/(@*,node())
                    }
             default
                 return $node
        }
    )(true())
};

(:~
 : Renames elements in `$nodes`.
 :)
declare function xf:rename($nodes as item()*, $map as item())
    as item()* {
    xf:rename($map)($nodes)
};

(:~
 : Create a node transformer that wraps nodes in
 : an element `$element` and adding attributes from `$map` if present.
 : Attributes already on `$element` cannot be overwritten.
 : An empty sequence will not be wrapped.
 :)
declare function xf:wrap($element-spec as item())
    as function(item()*) as element()? {
    let $args :=
        if ($element-spec instance of element()) then
            $element-spec
        else
            array:flatten($element-spec)
    let $element as element() := $args[1]
    let $map as map(*)? := $args[2]
    where $element
    return
        function($nodes as item()*) as element()? {
            if (exists($nodes)) then
                element { node-name($element) } {
                    $element/@*,
                    if (exists($map)) then
                        map:for-each(
                            $map,
                            function($k,$v) {
                                if (not($element/@*[node-name(.) eq xs:QName($k)])) then
                                    attribute { $k } { $v }
                                else
                                    ()
                            }
                        )
                    else
                        (),
                    $nodes
                }
            else
                ()
        }
};

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

(:~
 : Create 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(item()*) as item()* {
    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 item()*)
    as item()* {
    xf:unwrap()($nodes)
};

(:~
 : Returns a node transformer that transforms nodes using
 : an XSLT stylesheet.
 :)
declare function xf:xslt($stylesheet as item())
    as function(node()*) as node()* {
    xf:xslt($stylesheet, map {})
};

(:~
 : Create a node transformer that transforms nodes using
 : an XSLT stylesheet with parameters.
 :)
declare function xf:xslt($stylesheet as item(), $params as item())
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            xslt:transform($node, $stylesheet, $params)/*
        }
    )($params)
};

(:~
 : Transform `$nodes` using XSLT stylesheet.
 :)
declare function xf:xslt($nodes as item()*, $stylesheet as item(), $params as item())
    as item()* {
    xf:xslt($stylesheet, $params)($nodes)
};

(:
 : Creates a generic element node transformer function. It applies
 : `$transform` to each element passed.
 :)
declare function xf:element-transformer($transform as function(element()) as item()*)
    as function(*) {
    function($args as item()*) as function(*) {
        function($nodes as item()*) as item()* {
            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.
 :)

(:~
 : Environment map
 :
 : bindings -  a map with the bindings
 : namespaces - a map with namespaces
 : imports - a map with imports (key = ns prefix, value is two item list (ns, location))
 : options / memory
 : options / timeout
 : options / permission
 :)
declare function xf:environment($env-map as map(*)) as map(*) {
    let $bindings := ($env-map('bindings'), map {})[1]
    let $options := ($env-map('options'), map {})[1]
    let $prolog := string-join((

            let $imports := $env-map('imports')
            where $imports instance of map(*)
            for $import in map:keys($imports)
            return
                'import module namespace ' || $import || ' = "' ||
                    $imports($import)[1] || '" at "' ||
                    $imports($import)[2] || '";',

            let $nss := $env-map('namespaces')
            where $nss instance of map(*)
            for $ns in map:keys($nss)
            return
                'declare namespace ' || $ns || ' = "' || $nss($ns) || '";',

            let $vars := $env-map('bindings')
            where $vars instance of map(*)
            for $var in map:keys($vars)
            where $var ne ''
            return
                'declare variable $' || $var || ' external;'

        ),'')
    return
        map {
            'bindings': $bindings,
            'options': $options,
            'prolog': $prolog
        }

};

(:~
 : Create a function for querying over a given set of nodes.
 :
 : TODO: review if needed.
 :)
declare function xf:query($nodes as item()*, $env as map(*)) as function(*) {
    let $bindings := map:merge(($env('bindings'), map { '': $nodes }))
    return
        function($query as xs:string) as item()* {
            xquery:eval(trace($env('prolog') || $query, 'Q: '), $bindings, $env('options'))
        }
};

declare variable $xf:match-environment :=
    xf:environment(
        map { 'bindings':
            map { 'in':
                        function($att, $token) as xs:boolean {
                            $token = tokenize(string($att),'\s+')
                        }
                }
        }
    );

declare variable $xf:expr-environment :=
    xf:environment(
        map { 'bindings':
            map { 'in':
                        function($att, $token) as xs:boolean {
                            $token = tokenize(string($att),'\s+')
                        }
                }
        }
    );

(:~
 : Find matches for XPath expression string applied to passed in nodes
 : including all descendents.
 :)
declare function xf:select-all($selector as xs:string)
    as function(item()*) as item()* {
    let $env := $xf:match-environment
    let $bindings := $env('bindings')
    let $options := $env('options')
    let $prolog := $env('prolog')
    return
        function($nodes as item()*) as item()* {
            xquery:eval(
                $prolog || $selector,
                map:merge(($bindings,map {'': $nodes/descendant-or-self::node() })),
                $options
            )
        }
};

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

(:~
 : Find matches for XPath expression string applied to passed in nodes.
 : TODO: remove this in favor of xf:selector($env)
 :)
declare function xf:select($selector as xs:string)
    as function(item()*) as item()* {
    let $env := $xf:expr-environment
    let $bindings := $env('bindings')
    let $options := $env('options')
    let $prolog := $env('prolog')
    return
        function($nodes as item()*) as item()* {
            xquery:eval(
                $prolog || $selector,
                map:merge(($bindings,map {'': $nodes })),
                $options
            )
        }
};

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

(:~
 : Copies nodes to output, and calls apply for
 : nodes that are wrapped inside <xf:apply>.
 :)
declare %private function xf:copy-nodes($nodes as item()*, $xform as map(*)*)
    as item()* {
    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 item()*, $context as map(*)*, $xform as map(*)*)
    as item()* {
    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 item()*)
    as element() {
    xf:apply()($nodes)
};

(:~
 : Returns an apply node transfomrer. When used in `xf:transform` it will
 : pass the nodes through all tansformation rules similar to
 : `<xsl:apply-templates/>` in XSLT.
 :)
declare function xf:apply()
    as function(item()*) as element() {
    function ($nodes as item()*) as element() {
        typeswitch ($nodes)
        case element()
            return
                element { node-name($nodes) } {
                    $nodes/@*,
                    <xf:apply>{ $nodes/node() }</xf:apply>
                }
        default
            return
                <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 item(), $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:merge(($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 item(), $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(item()*) as item()* {
    (: 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()* {
                            for $node in $step return xf:copy($node)
                        })
                else if ($step instance of empty-sequence()) then
                    ($result,
                        function($node as item()*) as item()* {
                            ()
                        })
                else
                    ($result, text { $step })
            }
        )
    return
        function($nodes as item()*) as item()* {
            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(item()*) as item()*)* {
    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
};

declare %private function xf:copy($node as node())
    as node() {
    typeswitch($node)
    case element()
        return
            element { node-name($node) } {
                $node/@*,
                for $child in $node/node()
                     return xf:copy($child) }
    default return $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)
};

(:~
 : Load a plain text resource.
 :)
declare function xf:text-resource($url-or-path) {
    unparsed-text($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 function.
 :)
declare function xf:template($template as item()*, $selector as array(*)?, $model as item()*)
    as function(*) {
    let $at := if ($selector instance of array(*)) then xf:at($selector) else function($nodes) { $nodes }
    return
        typeswitch ($model)
        (: test array first because it is also a function :)
        case array(*)*
        return
            function() as item()* {
                $template => $at() => xf:transform($model)
            }
        case function(*)
        return
            switch (function-arity($model))
            case 0
            return
                function() as item()* {
                    $template => $at() => xf:transform($model)
                }
            case 1
            return
                function($arg1 as item()?) as item()* {
                    $template => $at() => xf:transform(apply($model, [$arg1]))
                }
            case 2
            return
                function($arg1 as item()?, $arg2 as item()?) as item()* {
                    $template => $at() => xf:transform(apply($model, [$arg1, $arg2]))
                }
            case 3
            return
                function($arg1 as item()?, $arg2 as item()?, $arg3 as item()?) as item()* {
                    $template => $at() => xf:transform(apply($model, [$arg1, $arg2, $arg3]))
                }
            (: max arity-4 supported :)
            case 4
            return
                function($arg1 as item()?, $arg2 as item()?, $arg3 as item()?, $arg4 as item()?) as item()* {
                    $template => $at() => xf:transform(apply($model, [$arg1, $arg2, $arg3, $arg4]))
                }
            default
            return
                error(xf:ArityNotSupportedError, 'A model function cannot have more than 4 arguments')

        case empty-sequence()
        return
            function() as item()* {
                $template => $at()
            }
        default
        return
            error(xf:InvalidModelError, 'This model cannot be used')
};

(:~
 : Apply `$template` to template function.
 :)
declare function xf:template($template as item(), $model as item()*)
    as function(*) {
    xf:template($template, (), $model)
};

(:~
 : Template identity transform.
 :)
declare function xf:template($template as item())
    as function(*) {
    xf:template($template, (), ())
};

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

(:~
 : Transform input, using the specified rules.
 :)
declare function xf:transform($nodes as item()*, $rules as array(*)*)
    as item()* {
    xf:transform($rules)($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($rules as array(*)*)
    as function(item()*) as item()* {
    xf:extract-outer($rules)
};

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

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

(:~
 : Apply extractor rules to `$nodes` and return the innermost nodes.
 :)
declare function xf:extract-inner($nodes as item()*, $rules as array(*)*)
    as item()* {
    xf:extract-inner($rules)($nodes)
};

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

(:~
 : Apply extractor rules to `$nodes` and return the outermost nodes.
 :)
declare function xf:extract-outer($nodes as item()*, $rules as array(*)*)
    as item()* {
    xf:extract-outer($rules)($nodes)
};

(:~
 : Create a match function from a rule.
 :)
declare function xf:match($rule as array(*))
    as map(*)? {
    let $select := xf:selector([array:head($rule)], xf:select#1)
    let $body := xf:do(array:tail($rule))
    where array:size($rule) gt 0
    return
        map {
            'select': $select,
            'fn': $body
        }
};

(:~
 : Create a selector function from a rule.
 :)
declare function xf:at($rule as array(*))
    as function(item()*) as item()* {
    xf:selector($rule, xf:select-all#1)
};

(:~
 : Apply a transformation rule to input nodes.
 :)
declare function xf:at($nodes as item()*, $rule as array(*))
    as item()* {
    xf:at($rule)($nodes)
};

(:~
 : Create a node transformer that applies a node transformation rule to a
 : sequence of input nodes.
 :)
declare function xf:do($rule as array(*))
    as function(item()*) as item()* {
    function($nodes as item()*) as item()* {
        xf:do-nodes($nodes, $rule)
    }
};

(:~
 : Apply a node transformation rule to a sequence of nodes.
 :)
declare function xf:do($nodes as item()*, $rule as array(*))
    as item()* {
    xf:do-nodes($nodes, $rule)
};

(:~
 : Create a node transformer that applies a node transformation rule to each
 : individual input node.
 :)
declare function xf:each($rule as array(*))
    as function(item()*) as item()* {
    function($nodes as item()*) as item()* {
        for $node in $nodes
            return xf:do-nodes($node, $rule)
    }
};

(:~
 : Apply a node transformation rule to each individual input node.
 :)
declare function xf:each($nodes as item()*, $rule as array(*))
    as item()* {
    for $node in $nodes
        return xf:do-nodes($node, $rule)
};

declare %private function xf:do-nodes($nodes as item()*, $rule as array(*))
    as item()* {
    array:fold-left(
        $rule,
        $nodes,
        function($nodes, $step) {
            if ($step instance of function(*)) then
                $step($nodes)
            else
                $step
        }
    )
};

(:~
 : Only nodes for which the chain of expressions evaluates to `true()`
 : are passed through.
 :)
declare function xf:if($conditions as item()*)
    as function(item()*) as item()* {
    let $conditions := xf:comp-expression($conditions)
    return
        function($nodes as item()*) as item()* {
            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 item()*, $conditions as item()*)
    as item()* {
    xf:if($conditions)($nodes)
};

(:~
 : Create a node transformer that replaces the child nodes of an
 : element with `$content`.
 :)
declare function xf:content($content as item()*)
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            element { node-name($node) } {
                $node/@*,
                $content
            }
        }
     (: HACK :)
    )(true())
};

(:~
 : Replace the child nodes of `$element` with `$content`.
 :)
declare function xf:content($nodes as item()*, $content as item()*)
    as item()* {
    xf:content($content)($nodes)
};

(:~
 : Create a node transformer that replaces the nodes passed with
 : `$replacement`.
 :)
declare function xf:replace($replacement as item()*)
    as function(item()*) as item()* {
    function($nodes as item()*) as item()* {
        if (exists($nodes)) then
            $replacement
        else
            $nodes
    }
};

(:~
 : Replace `$nodes` with `$replacement`.
 :)
declare function xf:replace($nodes as item()*, $replacement as item()*)
    as item()* {
    xf:replace($replacement)($nodes)
};

(:~
 : Create a node transformer that inserts `$before` before
 : the nodes passed in.
 :)
declare function xf:before($before as item()*)
    as function(item()*) as item()* {
    function($nodes as item()*) as item()* {
        ($before, $nodes)
    }
};

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

(:~
 : Create a node transformer that inserts `$after` after
 : the nodes passed in.
 :)
declare function xf:after($after as item()*)
    as function(item()*) as item()* {
    function($nodes as item()*) as item()* {
        ($nodes, $after)
    }
};

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

(:~
 : Create a node transformer that appends `$append` nodes
 : to the child nodes of each element of `$nodes`.
 :)
declare function xf:append($append as item()*)
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            element { node-name($node) } {
                $node/(@*,node()),
                $append
            }
        }
     (: HACK :)
    )(true())
};

(:~
 : Inserts `$append` nodes to the child nodes of each element in
 : `$nodes`.
 :)
declare function xf:append($nodes as item()*, $append as item()*)
    as item()* {
    xf:append($append)($nodes)
};

(:~
 : Create a node transformer that prepends `$prepend` nodes
 : to the child nodes of each element of `$nodes`.
 :)
declare function xf:prepend($prepend as item()*)
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            element { node-name($node) } {
                ($node/@*, $prepend, $node/node())
            }
        }
     (: HACK :)
    )(true())
};

(:~
 : Inserts `$prepend` nodes before the first child node of each element
 : in `$nodes`.
 :)
declare function xf:prepend($nodes as item()*, $prepend as item()*)
    as item()* {
    xf:prepend($prepend)($nodes)
};

(:~
 : Create a node transformer that returns a text node with
 : the space normalized string value of a node.
 :)
declare function xf:text()
    as function(item()*) as item()* {
    function($nodes as item()*) as item()* {
        if (exists($nodes)) then
            for $node in $nodes
                return
                    typeswitch ($node)
                    case map(*)
                    return
                        $node
                    case array(*)
                    return
                        $node
                    case function(*)
                    return
                        $node
                    default
                    return
                        text { string($node) }
        else
            ()
    }
};

(:~
 : Outputs the text value of `$nodes`.
 :)
declare function xf:text($nodes as item()*)
    as item()* {
    xf:text()($nodes)
};

(:~
 : Create a node transformer that sets attributes using a map
 : on each element in the nodes passed.
 :
 : Map keys must be valid as QNames or they will be ignored.
 :)
declare function xf:set-attr($attributes as item())
    as function(item()*) as item()* {
    let $attributes :=
        typeswitch ($attributes)
        case map(*)
            return
                map:for-each(
                    $attributes,
                    function($name, $value) {
                        if ($name castable as xs:QName) then
                            attribute { $name } { $value }
                        else
                            ()
                    }
                )
        case element()
            return $attributes/@*
        default
            return ()
    return
        xf:element-transformer(
            function($node as element()) as element() {
                element { node-name($node) } {
                    $attributes,
                    for $att in $node/@*
                        where node-name($att) != $attributes/node-name()
                        return $att,
                    $node/node()
                }
            }
        )($attributes)
};

(:~
 : Set attributes using a map on each element in `$nodes`.
 :)
declare function xf:set-attr($nodes as item()*, $attributes as item())
    as item()* {
    xf:set-attr($attributes)($nodes)
};

(:~
 : Create a node transformer that adds one or more class names to
 : each element in the nodes passed.
 :)
declare function xf:add-class($names as xs:string*)
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            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 item()*, $names as xs:string*)
    as item()* {
    xf:add-class($names)($nodes)
};

(:~
 : Create a node transformer that removes 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(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            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 item()*, $names as xs:string*)
    as item()* {
    xf:remove-class($names)($nodes)
};

(:~
 : Create a node transformer that remove attributes.
 :
 : If a name cannot be used as an attribute name (xs:QName) then
 : it will be silently ignored.
 :)
declare function xf:remove-attr($attributes as item()*)
    as function(item()*) as item()* {
    let $names :=
        typeswitch ($attributes)
        case xs:string*
            return
                for $name in $attributes
                return
                    if ($name eq '*') then
                        '*'
                    else if ($name castable as xs:QName) then
                        attribute { $name } { '' }
                    else
                        ()
        case element()
            return $attributes/@*
        case map(*)
            return
                map:for-each(
                    $attributes,
                    function($name,$value) {
                    if ($name castable as xs:QName) then
                        attribute { $name } { '' }
                    else
                        ()
                })
        default
            return ()
    return
        xf:element-transformer(
            function($node as element()) as element() {
                element { node-name($node) } {
                    for $att in $node/@*
                        where not($names = '*') and
                              not(node-name($att) = $names/node-name())
                        return $att
                }
            }
        )($attributes)
};

(:~
 : Remove attributes from each element in `$nodes`.
 :)
declare function xf:remove-attr($nodes as item()*, $names as item()*)
    as item()* {
    xf:remove-attr($names)($nodes)
};

(:~
 : Create a node-transformer that renames element nodes, passing non-element
 : nodes and element child nodes through unmodified.
 :
 : Renaming can be done using a:
 :
 : - `xs:string`: renames all elements
 : - `map(*)`: looks up the element name in the map and uses the value as the
 :   new name
 : - `function($node as element()) as item()`: passes the element node to the
 :   function using the return value as the new element name
 :)
declare function xf:rename($map as item())
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            typeswitch ($map)
            case map(*)
                return
                    if ($map(node-name($node))) then
                        element { $map(node-name($node)) } {
                            $node/(@*,node())
                        }
                    else if ($map(name($node))) then
                        element { $map(name($node)) } {
                            $node/(@*,node())
                        }
                    else
                        $node
             case function(*)
                 return
                    element { $map($node) } {
                        $node/(@*,node())
                    }
             case xs:string
                 return
                    element { $map } {
                        $node/(@*,node())
                    }
             default
                 return $node
        }
    )(true())
};

(:~
 : Renames elements in `$nodes`.
 :)
declare function xf:rename($nodes as item()*, $map as item())
    as item()* {
    xf:rename($map)($nodes)
};

(:~
 : Create a node transformer that wraps nodes in
 : an element `$element` and adding attributes from `$map` if present.
 : Attributes already on `$element` cannot be overwritten.
 : An empty sequence will not be wrapped.
 :)
declare function xf:wrap($element-spec as item())
    as function(item()*) as element()? {
    let $args :=
        if ($element-spec instance of element()) then
            $element-spec
        else
            array:flatten($element-spec)
    let $element as element() := $args[1]
    let $map as map(*)? := $args[2]
    where $element
    return
        function($nodes as item()*) as element()? {
            if (exists($nodes)) then
                element { node-name($element) } {
                    $element/@*,
                    if (exists($map)) then
                        map:for-each(
                            $map,
                            function($k,$v) {
                                if (not($element/@*[node-name(.) eq xs:QName($k)])) then
                                    attribute { $k } { $v }
                                else
                                    ()
                            }
                        )
                    else
                        (),
                    $nodes
                }
            else
                ()
        }
};

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

(:~
 : Create 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(item()*) as item()* {
    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 item()*)
    as item()* {
    xf:unwrap()($nodes)
};

(:~
 : Returns a node transformer that transforms nodes using
 : an XSLT stylesheet.
 :)
declare function xf:xslt($stylesheet as item())
    as function(node()*) as node()* {
    xf:xslt($stylesheet, map {})
};

(:~
 : Create a node transformer that transforms nodes using
 : an XSLT stylesheet with parameters.
 :)
declare function xf:xslt($stylesheet as item(), $params as item())
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            xslt:transform($node, $stylesheet, $params)/*
        }
    )($params)
};

(:~
 : Transform `$nodes` using XSLT stylesheet.
 :)
declare function xf:xslt($nodes as item()*, $stylesheet as item(), $params as item())
    as item()* {
    xf:xslt($stylesheet, $params)($nodes)
};

(:
 : Creates a generic element node transformer function. It applies
 : `$transform` to each element passed.
 :)
declare function xf:element-transformer($transform as function(element()) as item()*)
    as function(*) {
    function($args as item()*) as function(*) {
        function($nodes as item()*) as item()* {
            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.
 :)

(:~
 : Environment map
 :
 : bindings -  a map with the bindings
 : namespaces - a map with namespaces
 : imports - a map with imports (key = ns prefix, value is two item list (ns, location))
 : options / memory
 : options / timeout
 : options / permission
 :)
declare function xf:environment($env-map as map(*)) as map(*) {
    let $bindings := ($env-map('bindings'), map {})[1]
    let $options := ($env-map('options'), map {})[1]
    let $prolog := string-join((

            let $imports := $env-map('imports')
            where $imports instance of map(*)
            for $import in map:keys($imports)
            return
                'import module namespace ' || $import || ' = "' ||
                    $imports($import)[1] || '" at "' ||
                    $imports($import)[2] || '";',

            let $nss := $env-map('namespaces')
            where $nss instance of map(*)
            for $ns in map:keys($nss)
            return
                'declare namespace ' || $ns || ' = "' || $nss($ns) || '";',

            let $vars := $env-map('bindings')
            where $vars instance of map(*)
            for $var in map:keys($vars)
            return
                'declare variable $' || $var || ' external;'

        ),'')
    return
        map {
            'bindings': $bindings,
            'options': $options,
            'prolog': $prolog
        }

};

(:~
 : Create a function for querying over a given set of nodes.
 :
 : TODO: review if needed.
 :)
declare function xf:query($nodes as item()*, $env as map(*)) as function(*) {
    let $bindings := map:merge(($env('bindings'), map { '': $nodes }))
    return
        function($query as xs:string) as item()* {
            xquery:eval(trace($env('prolog') || $query, 'Q: '), $bindings, $env('options'))
        }
};

declare function xf:default-environment() {
    xf:environment(
        map { 'bindings':
            map { 'in':
                        function($att, $token) as xs:boolean {
                            $token = tokenize(string($att),'\s+')
                        }
                }
        }
    )
};

(:~
 : Find matches for XPath expression string applied to passed in nodes
 : including all descendents.
 :)
declare function xf:select-all($selector as xs:string)
    as function(item()*) as item()* {
    let $env := xf:default-environment()
    return
        function($nodes as item()*) as item()* {
            let $bindings := map:merge(($env('bindings'), map { '': $nodes/descendant-or-self::node() }))
            return
                xquery:eval($env('prolog') || $selector, $bindings, $env('options'))
        }
};

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

(:~
 : Find matches for XPath expression string applied to passed in nodes.
 : TODO: remove this in favor of xf:selector($env)
 :)
declare function xf:select($selector as xs:string)
    as function(item()*) as item()* {
    let $env := xf:default-environment()
    return
        function($nodes as item()*) as item()* {
            let $bindings := map:merge(($env('bindings'), map { '': $nodes }))
            return
                xquery:eval($env('prolog') || $selector, $bindings, $env('options'))
        }
};

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

(:~
 : Copies nodes to output, and calls apply for
 : nodes that are wrapped inside <xf:apply>.
 :)
declare %private function xf:copy-nodes($nodes as item()*, $xform as map(*)*)
    as item()* {
    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 item()*, $context as map(*)*, $xform as map(*)*)
    as item()* {
    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 item()*)
    as element() {
    xf:apply()($nodes)
};

(:~
 : Returns an apply node transfomrer. When used in `xf:transform` it will
 : pass the nodes through all tansformation rules similar to
 : `<xsl:apply-templates/>` in XSLT.
 :)
declare function xf:apply()
    as function(item()*) as element() {
    function ($nodes as item()*) as element() {
        typeswitch ($nodes)
        case element()
            return
                element { node-name($nodes) } {
                    $nodes/@*,
                    <xf:apply>{ $nodes/node() }</xf:apply>
                }
        default
            return
                <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 item(), $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:merge(($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 item(), $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(item()*) as item()* {
    (: 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()* {
                            for $node in $step return xf:copy($node)
                        })
                else if ($step instance of empty-sequence()) then
                    ($result,
                        function($node as item()*) as item()* {
                            ()
                        })
                else
                    ($result, text { $step })
            }
        )
    return
        function($nodes as item()*) as item()* {
            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(item()*) as item()*)* {
    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
};

declare %private function xf:copy($node as node())
    as node() {
    typeswitch($node)
    case element()
        return
            element { node-name($node) } {
                $node/@*,
                for $child in $node/node()
                     return xf:copy($child) }
    default return $node
};


Indenting turned on

Indenting turned on

xquery version "1.0" encoding "UTF-8";

declare option exist:serialize "method=html media-type=text/html indent=yes";

declare function local:traverse-collection($collection as xs:anyURI,
    $indent as xs:integer) as element(p)*
{
    for $sub-collection in xmldb:get-child-collections($collection)
    return
    (

{$sub-collection}
,
        local:traverse-collection(xs:anyURI(concat($collection, '/', $sub-collection)), $indent + 10),
        for $document in xmldb:get-child-resources($collection)
        return

{$document}

    )
};

{
    local:traverse-collection(xs:anyURI('/db/apps/exist-book'), 0)
}

xquery version "1.0" encoding "UTF-8";

declare option exist:serialize "method=html media-type=text/html indent=no";

declare function local:traverse-collection($collection as xs:anyURI,
    $indent as xs:integer) as element(p)*
{
    for $sub-collection in xmldb:get-child-collections($collection)
    return
    (

{$sub-collection}
,
        local:traverse-collection(xs:anyURI(concat($collection, '/', $sub-collection)), $indent + 10),
        for $document in xmldb:get-child-resources($collection)
        return

{$document}

    )
};

{
    local:traverse-collection(xs:anyURI('/db/apps/exist-book'), 0)
}


Add additional functions through `bin:unpack-double` from BaseX binary module

xquery version "3.0";
(:~
: BaseX binary module functions
:
:)
module namespace bin = "http://expath.org/ns/binary";

import module namespace a = "http://reecedunn.co.uk/xquery/annotations" at "res://reecedunn.co.uk/xquery/annotations.xqy";

declare %a:since("basex", "9.0") function bin:hex($in as xs:string?) as xs:base64Binary? external;
declare %a:since("basex", "9.0") function bin:bin($in as xs:string?) as xs:base64Binary? external;
declare %a:since("basex", "9.0") function bin:octal($in as xs:string?) as xs:base64Binary? external;
declare %a:since("basex", "9.0") function bin:to-octets($in as xs:base64Binary) as xs:integer* external;
declare %a:since("basex", "9.0") function bin:from-octets($in as xs:integer*) as xs:base64Binary external;
declare %a:since("basex", "9.0") function bin:length($in as xs:base64Binary) as xs:integer external;
declare %a:since("basex", "9.0") function bin:part($in as xs:base64Binary?, $offset as xs:integer) as xs:base64Binary? external;
declare %a:since("basex", "9.0") function bin:part($in as xs:base64Binary?, $offset as xs:integer, $size as xs:integer) as xs:base64Binary? external;
declare %a:since("basex", "9.0") function bin:join($in as xs:base64Binary*) as xs:base64Binary external;
declare %a:since("basex", "9.0") function bin:insert-before($in as xs:base64Binary?, $offset as xs:integer, $extra as xs:base64Binary?) as xs:base64Binary external;
declare %a:since("basex", "9.0") function bin:pad-left($in as xs:base64Binary?, $size as xs:integer) as xs:base64Binary? external;
declare %a:since("basex", "9.0") function bin:pad-left($in as xs:base64Binary?, $size as xs:integer, $octect as xs:integer) as xs:base64Binary? external;
declare %a:since("basex", "9.0") function bin:pad-right($in as xs:base64Binary?, $size as xs:integer) as xs:base64Binary? external;
declare %a:since("basex", "9.0") function bin:pad-right($in as xs:base64Binary?, $size as xs:integer, $octect as xs:integer) as xs:base64Binary? external;
declare %a:since("basex", "9.0") function bin:find($in as xs:base64Binary?, $offset as xs:integer, $search as xs:base64Binary) as xs:integer? external;
declare %a:since("basex", "9.0") function bin:decode-string($in as xs:base64Binary?, $encoding as xs:string) as xs:string? external;
declare %a:since("basex", "9.0") function bin:decode-string($in as xs:base64Binary?, $encoding as xs:string, $offset as xs:integer) as xs:string? external;
declare %a:since("basex", "9.0") function bin:decode-string($in as xs:base64Binary?, $encoding as xs:string, $offset as xs:integer, $size as xs:integer) as xs:string? external;
declare %a:since("basex", "9.0") function bin:encode-string($in as xs:string?, $encoding as xs:string) as xs:base64Binary? external;
declare %a:since("basex", "9.0") function bin:pack-double($in as xs:double) as xs:base64Binary external;
declare %a:since("basex", "9.0") function bin:pack-double($in as xs:double, $octet-order as xs:string) as xs:base64Binary external;
declare %a:since("basex", "9.0") function bin:pack-float($in as xs:float) as xs:base64Binary external;
declare %a:since("basex", "9.0") function bin:pack-float($in as xs:float, $octet-order as xs:string) as xs:base64Binary external;
declare %a:since("basex", "9.0") function bin:pack-integer($in as xs:integer, $size as xs:integer) as xs:base64Binary external;
declare %a:since("basex", "9.0") function bin:pack-integer($in as xs:integer, $size as xs:integer, $octet-order as xs:string) as xs:base64Binary external;
declare %a:since("basex", "9.0") function bin:unpack-double($in as xs:base64Binary, $offset as xs:integer) as xs:double external;
declare %a:since("basex", "9.0") function bin:unpack-double($in as xs:base64Binary, $offset as xs:integer, $octet-order as xs:string) as xs:double external;


cosmetic

cosmetic

import module namespace xqddf-test = "http://www.zorba-xquery.com/modules/xqddf/test" at "xqddf_prolog.xqlib";
import module namespace xqddf = "http://www.zorba-xquery.com/modules/xqddf";

xqddf:create-collection($xqddf-test:white-collection, (<wb>1</wb>,<wb>2</wb>,<wb>3</wb>,<wb>4</wb>,<wb>5</wb>,<wb>6</wb>,<wb>7</wb>,<wb>8</wb>,<wb>9</wb>,<wb>10</wb>));

xqddf:create-collection($xqddf-test:blue-collection, (<bb>1</bb>,<bb>2</bb>,<bb>3</bb>,<bb>4</bb>,<bb>5</bb>,<bb>6</bb>,<bb>7</bb>,<bb>8</bb>,<bb>9</bb>,<bb>10</bb>));

xqddf:delete-nodes-first($xqddf-test:white-collection, 10 cast as xs:unsignedLong);

xqddf:collection($xqddf-test:white-collection);


[bugfix] fixed sandbox to properly display atomic values in search result.

svn path=/trunk/eXist/; revision=9873

xquery version "1.0";

(:~
	Post-processes query results for the sandbox application. The
	controller first sends the user-supplied query to XQueryServlet
	for evaluation. The result is then passed to this script, which
	stores the result set into the HTTP session and returns the number
	of hits and time elapsed.

	Subsequent requests from the sandbox application may retrieve single
	items from the result set stored in the session (see controller).
:)

declare namespace sandbox="http://exist-db.org/xquery/sandbox";

declare option exist:serialize "method=xml media-type=text/xml omit-xml-declaration=no indent=no";

(:~
	Pretty print an XML fragment. Returns HTML to highlight the XML syntax.
:)
declare function sandbox:pretty-print($node as item()) {
	typeswitch ($node)
		case $elem as element(exist:match) return
			{$elem/node()}
		case $elem as element() return

				<
				{node-name($elem)}
				{
					for $attr in $elem/@*
					return (
						' ', {node-name($attr)},
						'="', {$attr/string()}, '"'
					)
				}
				{
					let $children := $elem/node()
					return
						if (count($children) gt 0) then (
							>,
							for $child in $children
							return
								sandbox:pretty-print($child),
							</,
							{node-name($elem)},
							>
						) else
							/>
				}

		case $text as text() return
			{$text}
		case $comment as comment() return

<-- {$comment/string()} -->

		case $pi as processing-instruction() return

<?{$pi/string()}?>

		default return
			$node
};

(:~ Retrieve a single query result. :)
declare function sandbox:retrieve($num as xs:integer) as element() {
    let $cached := session:get-attribute("cached")
	let $item :=
		if ($cached[$num] instance of node()) then
			util:expand($cached[$num], 'indent=yes')
		else
			$cached[$num]
	return

{$num}

			{ sandbox:pretty-print($item) }

};

(:~ Take the query results and store them into the HTTP session. :)
declare function sandbox:store-in-session($results as item()*) as element(result) {
	let $null := session:set-attribute('cached', $results)
	let $elapsed := request:get-attribute("elapsed")
	return
		<result hits="{count($results)}" elapsed="{if ($elapsed) then $elapsed else 0}"/>
};

(: 	When a query has been executed, its results will be passed into
	this script in the request attribute 'results'. The result is then
	stored into the HTTP session. Subsequent requests from the sandbox
	can reference a result item in the session by passing parameter 'num'.
:)
session:create(),
let $results := request:get-attribute("results")
let $pos := xs:integer(request:get-parameter("num", ()))
return
	if ($pos) then
		sandbox:retrieve($pos)
	else
		sandbox:store-in-session($results)

xquery version "1.0";

(:~
	Post-processes query results for the sandbox application. The
	controller first sends the user-supplied query to XQueryServlet
	for evaluation. The result is then passed to this script, which
	stores the result set into the HTTP session and returns the number
	of hits and time elapsed.

	Subsequent requests from the sandbox application may retrieve single
	items from the result set stored in the session (see controller).
:)

declare namespace sandbox="http://exist-db.org/xquery/sandbox";

declare option exist:serialize "method=xml media-type=text/xml omit-xml-declaration=no indent=no";

(:~
	Pretty print an XML fragment. Returns HTML to highlight the XML syntax.
:)
declare function sandbox:pretty-print($node as node()) {
	typeswitch ($node)
		case $elem as element(exist:match) return
			{$elem/node()}
		case $elem as element() return

				<
				{node-name($elem)}
				{
					for $attr in $elem/@*
					return (
						' ', {node-name($attr)},
						'="', {$attr/string()}, '"'
					)
				}
				{
					let $children := $elem/node()
					return
						if (count($children) gt 0) then (
							>,
							for $child in $children
							return
								sandbox:pretty-print($child),
							</,
							{node-name($elem)},
							>
						) else
							/>
				}

		case $text as text() return
			{$text}
		case $comment as comment() return

<-- {$comment/string()} -->

		case $pi as processing-instruction() return

<?{$pi/string()}?>

		default return
			$node
};

(:~ Retrieve a single query result. :)
declare function sandbox:retrieve($num as xs:integer) as element() {
    let $cached := session:get-attribute("cached")
	return

{$num}

			{ sandbox:pretty-print(util:expand($cached[$num], 'indent=yes')) }

};

(:~ Take the query results and store them into the HTTP session. :)
declare function sandbox:store-in-session($results as item()*) as element(result) {
	let $null := session:set-attribute('cached', $results)
	let $elapsed := request:get-attribute("elapsed")
	return
		<result hits="{count($results)}" elapsed="{if ($elapsed) then $elapsed else 0}"/>
};

(: 	When a query has been executed, its results will be passed into
	this script in the request attribute 'results'. The result is then
	stored into the HTTP session. Subsequent requests from the sandbox
	can reference a result item in the session by passing parameter 'num'.
:)
session:create(),
let $results := request:get-attribute("results")
let $pos := xs:integer(request:get-parameter("num", ()))
return
	if ($pos) then
		sandbox:retrieve($pos)
	else if ($results) then
		sandbox:store-in-session($results)
	else
		request:get-data()


MarkLogic: Update the run query to call the profile functions in profile mode.

(:
 : Copyright (C) 2018-2019 Reece H. Dunn
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at
 :
 : http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, software
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
 :)
xquery version "1.0-ml";
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.
 :
 : This script has additional logic to map the semantics of the REST/XCC API to
 : the semantics of the API implemented in the xquery-intellij-plugin to support
 : the Run/Debug Configurations of the IntelliJ IDEs. Specifically:
 :
 : 1.  If there is an error, the REST API returns a "500 Internal Error" HTTP
 :     status. This catches the error and returns an element(err:error) object.
 :
 : 2.  The variables are passed via the REST API as xs:untypedAtomic. This
 :     converts the variables to the type they were specified as in the
 :     xquery-intellij-plugin API.
 :
 : 3.  The REST API only returns the primitive type of each item.
 :)

declare variable $mode as xs:string external;
declare variable $mimetype as xs:string external;
declare variable $module-path as xs:string external;
declare variable $query as xs:string external;
declare variable $vars as xs:string external;
declare variable $types as xs:string external;

declare 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: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:error(
    $err:code as xs:QName,
    $err:description as xs:string?,
    $err:value as item()*,
    $err:module as xs:string?,
    $err:line-number as xs:integer?,
    $err:column-number as xs:integer,
    $err:additional as element(error:error)
) {
    <err:error xmlns:dbg="http://reecedunn.co.uk/xquery/debug">
        <err:code>{$err:code}</err:code>
        <err:vendor-code>{$err:additional/error:code/text()}</err:vendor-code>
        <err:description>{$err:additional/error:message/text()}</err:description>
        <err:value count="{count($err:value)}"></err:value>
        <err:module line="{$err:line-number}" column="{$err:column-number + 1}">{$err:module}</err:module>
        <dbg:stack>{
            for $frame in $err:additional/error:stack/error:frame[position() != last()]
            let $module := $frame/error:uri/text()
            let $line := $frame/error:line/text() cast as xs:integer?
            let $column := $frame/error:column/text() cast as xs:integer?
            return <dbg:frame><dbg:module line="{$line}" column="{$column + 1}">{$module}</dbg:module></dbg:frame>
        }</dbg:stack>
    </err:error>
};

declare function local:xquery($variables, $options, $mode) as item()* {
    if (string-length($query) ne 0) then
        switch ($mode)
        case "run" return xdmp:eval($query, $variables, $options)
        case "profile" return prof:eval($query, $variables, $options)
        default return ()
    else
        switch ($mode)
        case "run" return xdmp:invoke($module-path, $variables, $options)
        case "profile" return prof:invoke($module-path, $variables, $options)
        default return ()
};

try {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $options := ()

    let $retvals :=
        switch ($mimetype)
        case "application/xquery" return local:xquery($variables, $options, $mode)
        default return ()

    for $retval at $i in $retvals
    let $_ := local:derived-type-name($retval) ! xdmp:add-response-header("X-Derived-" || $i, .)
    return $retval
} catch * {
    let $_ := xdmp:add-response-header("X-Derived-1", "err:error")
    return local:error($err:code, $err:description, $err:value, $err:module, $err:line-number, $err:column-number, $err:additional)
}

(:
 : Copyright (C) 2018-2019 Reece H. Dunn
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at
 :
 : http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, software
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
 :)
xquery version "1.0-ml";
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.
 :
 : This script has additional logic to map the semantics of the REST/XCC API to
 : the semantics of the API implemented in the xquery-intellij-plugin to support
 : the Run/Debug Configurations of the IntelliJ IDEs. Specifically:
 :
 : 1.  If there is an error, the REST API returns a "500 Internal Error" HTTP
 :     status. This catches the error and returns an element(err:error) object.
 :
 : 2.  The variables are passed via the REST API as xs:untypedAtomic. This
 :     converts the variables to the type they were specified as in the
 :     xquery-intellij-plugin API.
 :
 : 3.  The REST API only returns the primitive type of each item.
 :)

declare variable $mode as xs:string external;
declare variable $mimetype as xs:string external;
declare variable $module-path as xs:string external;
declare variable $query as xs:string external;
declare variable $vars as xs:string external;
declare variable $types as xs:string external;

declare 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: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:error(
    $err:code as xs:QName,
    $err:description as xs:string?,
    $err:value as item()*,
    $err:module as xs:string?,
    $err:line-number as xs:integer?,
    $err:column-number as xs:integer,
    $err:additional as element(error:error)
) {
    <err:error xmlns:dbg="http://reecedunn.co.uk/xquery/debug">
        <err:code>{$err:code}</err:code>
        <err:vendor-code>{$err:additional/error:code/text()}</err:vendor-code>
        <err:description>{$err:additional/error:message/text()}</err:description>
        <err:value count="{count($err:value)}"></err:value>
        <err:module line="{$err:line-number}" column="{$err:column-number + 1}">{$err:module}</err:module>
        <dbg:stack>{
            for $frame in $err:additional/error:stack/error:frame[position() != last()]
            let $module := $frame/error:uri/text()
            let $line := $frame/error:line/text() cast as xs:integer?
            let $column := $frame/error:column/text() cast as xs:integer?
            return <dbg:frame><dbg:module line="{$line}" column="{$column + 1}">{$module}</dbg:module></dbg:frame>
        }</dbg:stack>
    </err:error>
};

declare function local:xquery($variables, $options, $mode) as item()* {
    if (string-length($query) ne 0) then
        switch ($mode)
        case "run" return xdmp:eval($query, $variables, $options)
        default return ()
    else
        switch ($mode)
        case "run" return xdmp:invoke($module-path, $variables, $options)
        default return ()
};

try {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $options := ()

    let $retvals :=
        switch ($mimetype)
        case "application/xquery" return local:xquery($variables, $options, $mode)
        default return ()

    for $retval at $i in $retvals
    let $_ := local:derived-type-name($retval) ! xdmp:add-response-header("X-Derived-" || $i, .)
    return $retval
} catch * {
    let $_ := xdmp:add-response-header("X-Derived-1", "err:error")
    return local:error($err:code, $err:description, $err:value, $err:module, $err:line-number, $err:column-number, $err:additional)
}