Cleaning up

Cleaning up

xquery version "3.0";

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

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

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

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

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

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

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

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

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

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

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

(:~
 : Returns an extractor function that returns selected nodes,
 : only innermost, in document order and duplicates eliminitated.
 :
 : TODO: when using ['*',()] this should delete the element
 :
 : TODO: this version still suffers from the problem with transforms
 :       being done before the inner/outermost which means that
 :       they still frustrate the distinct/duplicate nodes stuff
 :)
declare function xf:extract-inner($selectors as array(*)*)
    as function(node()*) as node()* {
    let $selectors :=
        for $selector in $selectors
        return
            xf:at($selector)
    return
        function($nodes as node()*) as node()* {
            innermost(
                for $selector in $selectors
                return $selector($nodes)
            )
        }
};

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

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

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

(:~
 : Defines a match template.
 :
 : A template takes a selector string or function and
 : a node transformation function or the items to return as
 : the template body.
 : Providing invalid matcher returns empty sequence.
 :)
declare function xf:match($template as array(*))
    as map(*)? {
    let $selector := xf:selector([array:head($template)])
    (: HACK: to work around an array:fold-left bug in 20141219 :)
    let $body := xf:do(array:filter($template,function($i) { not($i instance of xs:string) }))
    where array:size($template) gt 0
    return
        map {
            'select': $selector,
            'fn': $body
        }
};

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

xquery version "3.0";

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

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

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

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

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

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

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

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

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

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

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

(:~
 : Returns an extractor function that returns selected nodes,
 : only innermost, in document order and duplicates eliminitated.
 :
 : TODO: when using ['*',()] this should delete the element
 :
 : TODO: this version still suffers from the problem with transforms
 :       being done before the inner/outermost which means that
 :       they still frustrate the distinct/duplicate nodes stuff
 :)
declare function xf:extract-inner($selectors as array(*)*)
    as function(node()*) as node()* {
    let $selectors :=
        for $selector in $selectors
        return
            xf:at($selector)
    return
        function($nodes as node()*) as node()* {
            innermost(
                for $selector in $selectors
                return $selector($nodes)
            )
        }
};

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

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

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

(:~
 : Defines a match template.
 :
 : A template takes a selector string or function and
 : a node transformation function or the items to return as
 : the template body.
 : Providing invalid matcher returns empty sequence.
 :)
declare function xf:match($template as array(*))
    as map(*)? {
    let $selector := xf:selector([array:head($template)])
    (: HACK: to work around an array:fold-left bug in 20141219 :)
    let $body := xf:do(array:filter($template,function($i) { not($i instance of xs:string) }))
    where array:size($template) gt 0
    return
        map {
            'select': $selector,
            'fn': $body
        }
};

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

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

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

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

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

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

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

(: ================ node transformers ================ :)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

(: ================ environment ================ :)

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

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

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

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

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

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

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

(: ================ internal functions ================ :)

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

(:~
 : Applies nodes to output, but runs the template node transformer when it
 : encounters a node that was matched.
 :)
declare %private function xf:apply-nodes($nodes as node()*, $context as map(*)*, $xform as map(*)*)
    as node()* {
    for $node in $nodes
    let $context := (xf:match-templates($node, $xform), $context)
    let $match := xf:matched-template($node, $context)
    return
        if ($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.
 : TODO: maybe rename to xf:apply-rules
 :)
declare function xf:apply($nodes as node()*)
    as element(xf:apply) {
    <xf:apply>{ $nodes }</xf:apply>
};

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

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

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

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

(:~
 : Is node defined in 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
};


fixed references to module locations in csd_mcs

(:~
: This is the Care Services Discovery stored query registry
: @version 1.0
: @see https://github.com/his-interop/openinfoman
:
:)
module namespace csd_mcs = "https://github.com/his-interop/openinfoman/csd_mcs";
import module namespace csd_lsc = "https://github.com/his-interop/openinfoman/csd_lsc" at "csd_local_services_cache.xqm";
import module namespace csd_psd = "https://github.com/his-interop/openinfoman/csd_psd" at "csd_poll_service_directories.xqm";
import module namespace csd_dm = "https://github.com/his-interop/openinfoman/csd_dm" at "csd_document_manager.xqm";

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

declare variable $csd_mcs:merged_services_doc := 'merged_services.xml';

declare function csd_mcs:store_exists($db) {
  db:is-xml($db, $csd_mcs:merged_services_doc)
};

declare updating function csd_mcs:init_store($db) {
  db:add($db, csd_lsc:blank_directory(), $csd_mcs:merged_services_doc)
};

(:
: Merges together all documents registered with the document manager
:)
declare updating function csd_mcs:merge($db) {

  (: Merges together all cached documents only
  for $name in csd_psd:registered_directories($db)
  return csd_lsc:refresh_doc(db:open($db,$csd_mcs:merged_services_doc),csd_lsc:get_cache($db,$name))
  :)

  for $name in csd_dm:registered_documents($db)
  return if ($name != csd_mcs:get_merge_doc_name()) then
    csd_lsc:refresh_doc(db:open($db, $csd_mcs:merged_services_doc), csd_dm:open_document($db, $name))
  else ()

};

declare function csd_mcs:get($db) {
  db:open($db,$csd_mcs:merged_services_doc)
};

declare updating function csd_mcs:empty($db) {
  db:replace($db, $csd_mcs:merged_services_doc, csd_lsc:blank_directory())
};

declare function csd_mcs:get_merge_doc_name() {
  let $name := 'merged_remote_services'
  return $name
};

(:~
: This is the Care Services Discovery stored query registry
: @version 1.0
: @see https://github.com/his-interop/openinfoman
:
:)
module namespace csd_mcs = "https://github.com/his-interop/openinfoman/csd_mcs";
import module namespace csd_lsc = "https://github.com/his-interop/openinfoman/csd_lsc" at "csd_local_services_cache.xqm";
import module namespace csd_psd = "https://github.com/his-interop/openinfoman/csd_psd" at "../repo/csd_poll_service_directories.xqm";
import module namespace csd_dm = "https://github.com/his-interop/openinfoman/csd_dm" at "../repo/csd_document_manager.xqm";

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

declare variable $csd_mcs:merged_services_doc := 'merged_services.xml';

declare function csd_mcs:store_exists($db) {
  db:is-xml($db, $csd_mcs:merged_services_doc)
};

declare updating function csd_mcs:init_store($db) {
  db:add($db, csd_lsc:blank_directory(), $csd_mcs:merged_services_doc)
};

(:
: Merges together all documents registered with the document manager
:)
declare updating function csd_mcs:merge($db) {

  (: Merges together all cached documents only
  for $name in csd_psd:registered_directories($db)
  return csd_lsc:refresh_doc(db:open($db,$csd_mcs:merged_services_doc),csd_lsc:get_cache($db,$name))
  :)

  for $name in csd_dm:registered_documents($db)
  return if ($name != csd_mcs:get_merge_doc_name()) then
    csd_lsc:refresh_doc(db:open($db, $csd_mcs:merged_services_doc), csd_dm:open_document($db, $name))
  else ()

};

declare function csd_mcs:get($db) {
  db:open($db,$csd_mcs:merged_services_doc)
};

declare updating function csd_mcs:empty($db) {
  db:replace($db, $csd_mcs:merged_services_doc, csd_lsc:blank_directory())
};

declare function csd_mcs:get_merge_doc_name() {
  let $name := 'merged_remote_services'
  return $name
};


[hotfix] add annotation to unparsed-text tests

Declare that tests need internet access with
assumeInternetAccess annotation.

refs #4542

(:
 : eXist-db Open Source Native XML Database
 : Copyright (C) 2001 The eXist-db Authors
 :
 : info@exist-db.org
 : http://www.exist-db.org
 :
 : This library is free software; you can redistribute it and/or
 : modify it under the terms of the GNU Lesser General Public
 : License as published by the Free Software Foundation; either
 : version 2.1 of the License, or (at your option) any later version.
 :
 : This library is distributed in the hope that it will be useful,
 : but WITHOUT ANY WARRANTY; without even the implied warranty of
 : MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 : Lesser General Public License for more details.
 :
 : You should have received a copy of the GNU Lesser General Public
 : License along with this library; if not, write to the Free Software
 : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 :)
xquery version "3.1";

(:~
 : Test fn:unparsed-text and friends
 :)
module namespace upt="http://exist-db.org/xquery/test/unparsed-text";

import module namespace system="http://exist-db.org/xquery/system";
import module namespace test="http://exist-db.org/xquery/xqsuite" at "resource:org/exist/xquery/lib/xqsuite/xqsuite.xql";
import module namespace xmldb="http://exist-db.org/xquery/xmldb";

declare
    %test:setUp
function upt:store() {
    let $col := xmldb:create-collection("/db", "test-unparsed-text")
    return (
        xmldb:store($col, "test.txt", "Hello
world!
Hello
world!", "application/octet-stream"),
        xmldb:store($col, "test.xml", "
Hello world!
", "application/xml")
    )
};

declare
    %test:tearDown
function upt:cleanup() {
    xmldb:remove("/db/test-unparsed-text")
};

declare
    %test:assumeInternetAccess("https://raw.githubusercontent.com")
    %test:assertXPath("contains($result, 'eXist')")
function upt:unparsed-text-from-url() {
    unparsed-text("https://raw.githubusercontent.com/eXist-db/exist/develop/exist-core/src/test/xquery/README")
};

declare
    %test:assumeInternetAccess("https://raw.githubusercontent.com")
    %test:assertXPath("contains($result, '----')")
function upt:unparsed-text-lines-from-url() {
    unparsed-text-lines("https://raw.githubusercontent.com/eXist-db/exist/develop/exist-core/src/test/xquery/README")[2]
};

declare
    %test:assumeInternetAccess("https://raw.githubusercontent.com")
    %test:assertEquals(6)
function upt:unparsed-text-lines-from-url-count() {
    count(unparsed-text-lines("https://raw.githubusercontent.com/eXist-db/exist/develop/exist-core/src/test/xquery/README"))
};

declare
    %test:assumeInternetAccess("https://raw.githubusercontent.com")
    %test:assertXPath("contains($result, 'eXist')")
function upt:unparsed-text-from-url-encoding() {
    unparsed-text("https://raw.githubusercontent.com/eXist-db/exist/develop/exist-core/src/test/xquery/README", "UTF-8")
};

declare
    %test:assertEquals("Hello
world!
Hello
world!")
function upt:unparsed-text-from-db() {
    unparsed-text("/db/test-unparsed-text/test.txt")
};

declare
    %test:assertEquals("Hello
world!
Hello
world!")
function upt:unparsed-text-from-db-full() {
    unparsed-text("xmldb:exist:///db/test-unparsed-text/test.txt")
};

declare
    %test:assertEquals("Hello", "world!", "Hello", "world!")
function upt:unparsed-text-lines-from-db() {
    unparsed-text-lines("/db/test-unparsed-text/test.txt")
};

declare
    %test:assertEquals("
Hello world!
")
function upt:unparsed-text-from-db-xml() {
    unparsed-text("/db/test-unparsed-text/test.xml")
};

declare
    %test:assertEquals(26436)
    %test:pending("Requires external file, should use a temp file which is setup by the test setup method")
function upt:unparsed-text-from-file-dba() {
    let $home := translate(system:get-exist-home(), "\", "/")
    let $url := ``[file://`{$home}`/LICENSE]``
    return
        string-length(unparsed-text($url))
};

declare
    %test:assertEquals(504)
    %test:pending("Requires external file, should use a temp file which is setup by the test setup method")
function upt:unparsed-text-lines-from-file-dba() {
    let $home := translate(system:get-exist-home(), "\", "/")
    let $url := ``[file://`{$home}`/LICENSE]``
    return
        count(unparsed-text-lines($url))
};

declare
    %test:assertError("FOUT1170")
function upt:unparsed-text-from-file-not-allowed() {
    system:as-user("guest", "guest", unparsed-text("file:///etc/passwd"))
};

declare
    %test:assertError("FOUT1170")
function upt:fragment-identifier() {
    unparsed-text-lines("http://www.example.org/#fragment")
};

declare
    %test:assertError("FOUT1170")
function upt:fragment-identifier-encoding() {
    unparsed-text("http://www.example.org/#fragment", "UTF-8")
};

declare
    %test:assertError("FOUT1170")
function upt:invalid-uri() {
    unparsed-text-lines("http://www.example.org/%gg")
};

declare
    %test:assertError("FOUT1170")
function upt:invalid-uri2() {
    unparsed-text-lines(":/")
};

declare
    %test:assumeInternetAccess("https://www.w3.org")
    %test:assertError("FOUT1170")
function upt:non-existent() {
    unparsed-text-lines("https://www.w3.org/fots/unparsed-text/does-not-exist.txt")
};

(:~
 : this test will fail as the server responds with a
 : permanent redirect that is neither followed nor
 : treated as an error
 : @see https://github.com/eXist-db/exist/issues/4542
 :)
declare
    %test:pending
    %test:assumeInternetAccess("https://www.w3.org")
    %test:assertError("FOUT1170")
function upt:non-existent-redirect() {
    unparsed-text-lines("http://www.w3.org/fots/unparsed-text/does-not-exist.txt")
};

declare
    %test:assertError("FOUT1170")
function upt:unsupported-scheme() {
    fn:unparsed-text-lines("surely-nobody-supports-this:/path.txt")
};

declare
    %test:assertError("FOUT1170")
function upt:windows-path() {
    unparsed-text-lines("C:\file-might-exist.txt", "UTF-8")
};

declare
    %test:assumeInternetAccess("https://raw.githubusercontent.com")
    %test:assertTrue
function upt:unparsed-text-available-from-url() {
    unparsed-text-available("https://raw.githubusercontent.com/eXist-db/exist/develop/exist-core/src/test/xquery/README")
};

declare
    %test:assumeInternetAccess("https://raw.githubusercontent.com")
    %test:assertTrue
function upt:unparsed-text-available-from-url-encoding() {
    unparsed-text-available("https://raw.githubusercontent.com/eXist-db/exist/develop/exist-core/src/test/xquery/README", "UTF-8")
};

declare
    %test:assumeInternetAccess("https://raw.githubusercontent.com")
    %test:assertFalse
function upt:unparsed-text-available-from-url-encoding-no-content() {
    unparsed-text-available("https://raw.githubusercontent.com/eXist-db/exist/develop/exist-core/src/test/xquery/READMEaaaa", "UTF-8")
};

declare
    %test:assertTrue
function upt:unparsed-text-available-from-db() {
    unparsed-text-available("/db/test-unparsed-text/test.txt")
};

declare
    %test:assertTrue
function upt:unparsed-text-available-from-db-full() {
    unparsed-text-available("xmldb:exist:///db/test-unparsed-text/test.txt")
};

declare
    %test:assertTrue
function upt:unparsed-text-available-from-db-xml() {
    unparsed-text-available("/db/test-unparsed-text/test.xml")
};

declare
    %test:assertFalse
function upt:unparsed-text-available-fragment-identifier() {
    unparsed-text-available("http://www.example.org/#fragment")
};

declare
    %test:assertFalse
function upt:unparsed-text-available-fragment-identifier-encoding() {
    unparsed-text-available("http://www.example.org/#fragment", "UTF-8")
};

declare
    %test:assertFalse
function upt:unparsed-text-available-invalid-uri() {
    unparsed-text-available("http://www.example.org/%gg")
};

declare
    %test:assertFalse
function upt:unparsed-text-available-invalid-uri2() {
    unparsed-text-available(":/")
};

declare
    %test:assumeInternetAccess("https://www.w3.org")
    %test:assertFalse
function upt:unparsed-text-available-non-existent() {
    unparsed-text-available("https://www.w3.org/fots/unparsed-text/does-not-exist.txt")
};

(:~
 : this test will fail as the server responds with a
 : permanent redirect that is neither followed nor
 : treated as an error
 : @see https://github.com/eXist-db/exist/issues/4542
 :)
declare
    %test:pending
    %test:assumeInternetAccess("https://www.w3.org")
    %test:assertFalse
function upt:unparsed-text-available-non-existent-redirect() {
    unparsed-text-available("http://www.w3.org/fots/unparsed-text/does-not-exist.txt")
};

declare
    %test:assertFalse
function upt:unparsed-text-available-unsupported-scheme() {
    fn:unparsed-text-available("surely-nobody-supports-this:/path.txt")
};

(:
 : eXist-db Open Source Native XML Database
 : Copyright (C) 2001 The eXist-db Authors
 :
 : info@exist-db.org
 : http://www.exist-db.org
 :
 : This library is free software; you can redistribute it and/or
 : modify it under the terms of the GNU Lesser General Public
 : License as published by the Free Software Foundation; either
 : version 2.1 of the License, or (at your option) any later version.
 :
 : This library is distributed in the hope that it will be useful,
 : but WITHOUT ANY WARRANTY; without even the implied warranty of
 : MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 : Lesser General Public License for more details.
 :
 : You should have received a copy of the GNU Lesser General Public
 : License along with this library; if not, write to the Free Software
 : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 :)
xquery version "3.1";

(:~
 : Test fn:unparsed-text and friends
 :)
module namespace upt="http://exist-db.org/xquery/test/unparsed-text";

import module namespace system="http://exist-db.org/xquery/system";
import module namespace test="http://exist-db.org/xquery/xqsuite" at "resource:org/exist/xquery/lib/xqsuite/xqsuite.xql";
import module namespace xmldb="http://exist-db.org/xquery/xmldb";

declare
    %test:setUp
function upt:store() {
    let $col := xmldb:create-collection("/db", "test-unparsed-text")
    return (
        xmldb:store($col, "test.txt", "Hello
world!
Hello
world!", "application/octet-stream"),
        xmldb:store($col, "test.xml", "
Hello world!
", "application/xml")
    )
};

declare
    %test:tearDown
function upt:cleanup() {
    xmldb:remove("/db/test-unparsed-text")
};

declare
    %test:assumeInternetAccess("https://raw.githubusercontent.com")
    %test:assertXPath("contains($result, 'eXist')")
function upt:unparsed-text-from-url() {
    unparsed-text("https://raw.githubusercontent.com/eXist-db/exist/develop/exist-core/src/test/xquery/README")
};

declare
    %test:assumeInternetAccess("https://raw.githubusercontent.com")
    %test:assertXPath("contains($result, '----')")
function upt:unparsed-text-lines-from-url() {
    unparsed-text-lines("https://raw.githubusercontent.com/eXist-db/exist/develop/exist-core/src/test/xquery/README")[2]
};

declare
    %test:assumeInternetAccess("https://raw.githubusercontent.com")
    %test:assertEquals(6)
function upt:unparsed-text-lines-from-url-count() {
    count(unparsed-text-lines("https://raw.githubusercontent.com/eXist-db/exist/develop/exist-core/src/test/xquery/README"))
};

declare
    %test:assumeInternetAccess("https://raw.githubusercontent.com")
    %test:assertXPath("contains($result, 'eXist')")
function upt:unparsed-text-from-url-encoding() {
    unparsed-text("https://raw.githubusercontent.com/eXist-db/exist/develop/exist-core/src/test/xquery/README", "UTF-8")
};

declare
    %test:assertEquals("Hello
world!
Hello
world!")
function upt:unparsed-text-from-db() {
    unparsed-text("/db/test-unparsed-text/test.txt")
};

declare
    %test:assertEquals("Hello
world!
Hello
world!")
function upt:unparsed-text-from-db-full() {
    unparsed-text("xmldb:exist:///db/test-unparsed-text/test.txt")
};

declare
    %test:assertEquals("Hello", "world!", "Hello", "world!")
function upt:unparsed-text-lines-from-db() {
    unparsed-text-lines("/db/test-unparsed-text/test.txt")
};

declare
    %test:assertEquals("
Hello world!
")
function upt:unparsed-text-from-db-xml() {
    unparsed-text("/db/test-unparsed-text/test.xml")
};

declare
    %test:assertEquals(26436)
    %test:pending("Requires external file, should use a temp file which is setup by the test setup method")
function upt:unparsed-text-from-file-dba() {
    let $home := translate(system:get-exist-home(), "\", "/")
    let $url := ``[file://`{$home}`/LICENSE]``
    return
        string-length(unparsed-text($url))
};

declare
    %test:assertEquals(504)
    %test:pending("Requires external file, should use a temp file which is setup by the test setup method")
function upt:unparsed-text-lines-from-file-dba() {
    let $home := translate(system:get-exist-home(), "\", "/")
    let $url := ``[file://`{$home}`/LICENSE]``
    return
        count(unparsed-text-lines($url))
};

declare
    %test:assertError("FOUT1170")
function upt:unparsed-text-from-file-not-allowed() {
    system:as-user("guest", "guest", unparsed-text("file:///etc/passwd"))
};

declare
    %test:assertError("FOUT1170")
function upt:fragment-identifier() {
    unparsed-text-lines("http://www.example.org/#fragment")
};

declare
    %test:assertError("FOUT1170")
function upt:fragment-identifier-encoding() {
    unparsed-text("http://www.example.org/#fragment", "UTF-8")
};

declare
    %test:assertError("FOUT1170")
function upt:invalid-uri() {
    unparsed-text-lines("http://www.example.org/%gg")
};

declare
    %test:assertError("FOUT1170")
function upt:invalid-uri2() {
    unparsed-text-lines(":/")
};

declare
    %test:assertError("FOUT1170")
function upt:non-existent() {
    unparsed-text-lines("https://www.w3.org/fots/unparsed-text/does-not-exist.txt")
};

(:~
 : this test will fail as the server responds with a
 : permanent redirect that is neither followed nor
 : treated as an error
 : @see https://github.com/eXist-db/exist/issues/4542
 :)
declare
    %test:pending
    %test:assertError("FOUT1170")
function upt:non-existent-redirect() {
    unparsed-text-lines("http://www.w3.org/fots/unparsed-text/does-not-exist.txt")
};

declare
    %test:assertError("FOUT1170")
function upt:unsupported-scheme() {
    fn:unparsed-text-lines("surely-nobody-supports-this:/path.txt")
};

declare
    %test:assertError("FOUT1170")
function upt:windows-path() {
    unparsed-text-lines("C:\file-might-exist.txt", "UTF-8")
};

declare
    %test:assumeInternetAccess("https://raw.githubusercontent.com")
    %test:assertTrue
function upt:unparsed-text-available-from-url() {
    unparsed-text-available("https://raw.githubusercontent.com/eXist-db/exist/develop/exist-core/src/test/xquery/README")
};

declare
    %test:assumeInternetAccess("https://raw.githubusercontent.com")
    %test:assertTrue
function upt:unparsed-text-available-from-url-encoding() {
    unparsed-text-available("https://raw.githubusercontent.com/eXist-db/exist/develop/exist-core/src/test/xquery/README", "UTF-8")
};

declare
    %test:assumeInternetAccess("https://raw.githubusercontent.com")
    %test:assertFalse
function upt:unparsed-text-available-from-url-encoding-no-content() {
    unparsed-text-available("https://raw.githubusercontent.com/eXist-db/exist/develop/exist-core/src/test/xquery/READMEaaaa", "UTF-8")
};

declare
    %test:assertTrue
function upt:unparsed-text-available-from-db() {
    unparsed-text-available("/db/test-unparsed-text/test.txt")
};

declare
    %test:assertTrue
function upt:unparsed-text-available-from-db-full() {
    unparsed-text-available("xmldb:exist:///db/test-unparsed-text/test.txt")
};

declare
    %test:assertTrue
function upt:unparsed-text-available-from-db-xml() {
    unparsed-text-available("/db/test-unparsed-text/test.xml")
};

declare
    %test:assertFalse
function upt:unparsed-text-available-fragment-identifier() {
    unparsed-text-available("http://www.example.org/#fragment")
};

declare
    %test:assertFalse
function upt:unparsed-text-available-fragment-identifier-encoding() {
    unparsed-text-available("http://www.example.org/#fragment", "UTF-8")
};

declare
    %test:assertFalse
function upt:unparsed-text-available-invalid-uri() {
    unparsed-text-available("http://www.example.org/%gg")
};

declare
    %test:assertFalse
function upt:unparsed-text-available-invalid-uri2() {
    unparsed-text-available(":/")
};

declare
    %test:assertFalse
function upt:unparsed-text-available-non-existent() {
    unparsed-text-available("https://www.w3.org/fots/unparsed-text/does-not-exist.txt")
};

(:~
 : this test will fail as the server responds with a
 : permanent redirect that is neither followed nor
 : treated as an error
 : @see https://github.com/eXist-db/exist/issues/4542
 :)
declare
    %test:pending
    %test:assertFalse
function upt:unparsed-text-available-non-existent-redirect() {
    unparsed-text-available("http://www.w3.org/fots/unparsed-text/does-not-exist.txt")
};

declare
    %test:assertFalse
function upt:unparsed-text-available-unsupported-scheme() {
    fn:unparsed-text-available("surely-nobody-supports-this:/path.txt")
};


[test] Add mixed array sort test

[test] Add mixed array sort test

(:
 : eXist-db Open Source Native XML Database
 : Copyright (C) 2001 The eXist-db Authors
 :
 : info@exist-db.org
 : http://www.exist-db.org
 :
 : This library is free software; you can redistribute it and/or
 : modify it under the terms of the GNU Lesser General Public
 : License as published by the Free Software Foundation; either
 : version 2.1 of the License, or (at your option) any later version.
 :
 : This library is distributed in the hope that it will be useful,
 : but WITHOUT ANY WARRANTY; without even the implied warranty of
 : MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 : Lesser General Public License for more details.
 :
 : You should have received a copy of the GNU Lesser General Public
 : License along with this library; if not, write to the Free Software
 : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 :)
xquery version "3.1";

(:~
 : Tests for the array datatype and associated functions.
 :)
module namespace arr="http://exist-db.org/test/arrays";

declare namespace test="http://exist-db.org/xquery/xqsuite";
declare namespace output="http://www.w3.org/2010/xslt-xquery-serialization";
declare namespace json="http://www.json.org";

declare variable $arr:SERIALIZE_JSON :=
    <output:serialization-parameters>
        <output:method>json</output:method>
        <output:indent>no</output:indent>
    </output:serialization-parameters>;

declare variable $arr:SERIALIZE_JSON_INDENT :=
    <output:serialization-parameters>
        <output:method>json</output:method>
        <output:indent>yes</output:indent>
    </output:serialization-parameters>;

declare variable $arr:COLLECTION_CONF :=
    <collection xmlns="http://exist-db.org/collection-config/1.0">
        <index xmlns:xs="http://www.w3.org/2001/XMLSchema">
            <create qname="a" type="xs:int"/>
            <range>
                <create qname="b" type="xs:int"/>
            </range>
        </index>
    </collection>;

declare variable $arr:XML_STORED :=
    <test>
        1
        2
    </test>;

declare variable $arr:primes := [2, 3, 5, 7, 11, 13, 17, 19];

declare
    %test:setUp
function arr:setup() {
    let $json := '[{"key1": "value1", "key2": "value2", "key1": "value3"}]'
    let $coll := xmldb:create-collection("/db", "array-test")
    let $confColl := xmldb:create-collection("/db/system/config/db", "array-test")
    return (
        xmldb:store($confColl, "collection.xconf", $arr:COLLECTION_CONF),
        xmldb:store($coll, "test.json", $json),
        xmldb:store($coll, "test.xml", $arr:XML_STORED)
    )
};

declare
    %test:tearDown
function arr:cleanup() {
    xmldb:remove("/db/array-test"),
    xmldb:remove("/db/system/config/db/array-test")
};

declare
    %test:args(1)
    %test:assertEquals(13)
    %test:args(3)
    %test:assertEquals(14)
function arr:function-item($pos as xs:int) {
    [13, 10, 14]($pos)
};

declare
    %test:args(1)
    %test:assertEquals(13)
    %test:args(3)
    %test:assertEquals(14)
function arr:function-item2($pos as xs:int) {
    let $a := [13, 10, 14]
    return
        $a($pos)
};

declare
    %test:args(1)
    %test:assertEquals(13)
    %test:args(3)
    %test:assertEquals(14)
function arr:function-item3($pos as xs:int) {
    let $a := [13, 10, 14]
    let $f := function($array as function(*), $position as xs:int) {
        $array($position)
    }
    return
        $f($a, $pos)
};

declare
    %test:assertError("FOAY0001")
function arr:function-item-out-of-bounds() {
    let $a := [13, 10, 14]
    return
        $a(22)
};

declare
    %test:assertError("err:XPTY0004")
function arr:function-item-invalid() {
    let $a := [13, 10, 14]
    return
        $a("x")
};

declare
    %test:assertError("FOAY0001")
function arr:get-item-out-of-bounds-positive() {
    let $a := [13, 10, 14]
    return
        array:get($a, 4)
};

declare
    %test:assertError("FOAY0001")
function arr:get-item-out-of-bounds-positive-large() {
    let $a := [13, 10, 14]
    return
        array:get($a, 22)
};

declare
    %test:assertError("FOAY0001")
function arr:get-item-out-of-bounds-zero() {
    let $a := [13, 10, 14]
    return
        array:get($a, 0)
};

declare
    %test:assertError("FOAY0001")
function arr:get-item-out-of-bounds-negative() {
    let $a := [13, 10, 14]
    return
        array:get($a, -1)
};

declare
    %test:pending("eXist-db does not correctly detect the type error. This is likely a larger issue than just arrays.")
    %test:assertError("XPTY0004")
function arr:get-invalid-type() {
    let $a := [13, 10, 14]
    return
        array:get($a, xs:double(0.1))
};

declare
    %test:assertEquals(13)
function arr:get-first() {
    let $a := [13, 10, 14]
    return
        array:get($a, 1)
};

declare
    %test:assertEquals(14)
function arr:get-last() {
    let $a := [13, 10, 14]
    return
        array:get($a, 3)
};

declare
    %test:args(1)
    %test:assertEmpty
    %test:args(2)
    %test:assertEquals(27, 17, 0)
function arr:square-constructor1($pos as xs:int) {
    let $a := [(), (27, 17, 0)]
    return $a($pos)
};

declare
    %test:args(1)
    %test:assertEquals("
test
")
    %test:args(2)
    %test:assertEquals(55)
function arr:square-constructor2($pos as xs:int) {
    let $a := [
test
, 55]
    return $a($pos)
};

declare
    %test:assertEquals(0)
function arr:square-constructor3() {
    let $a := []
    return array:size($a)
};

declare
    %test:args(1)
    %test:assertEquals(27)
    %test:args(2)
    %test:assertEquals(17)
function arr:curly-constructor1($pos as xs:int) {
    let $x := (27, 17, 0)
    let $a := array { $x }
    return $a($pos)
};

declare
    %test:args(1)
    %test:assertEquals(27)
    %test:args(2)
    %test:assertEquals(17)
function arr:curly-constructor2($pos as xs:int) {
    let $a := array { (), (27, 17, 0) }
    return $a($pos)
};

declare
    %test:assertTrue
function arr:deep-equal1() {
    deep-equal([1, <node/>, "a", ["b", "c"]], [1, <node/>, "a", ["b", "c"]])
};

declare
    %test:assertFalse
function arr:deep-equal2() {
    deep-equal([1, 2, "a", ["b", "c"]], [1, 2, "a", ["b", "a"]])
};

declare
    %test:assertEquals(2)
function arr:with-map1() {
    let $a := [ map { "a": 1, "b": 2 } ]
    return $a(1)("b")
};

declare
    %test:assertEquals(3)
function arr:with-map2() {
    let $a := map { "a": 1, "b": [2, 3, 4] }
    return $a("b")(2)
};

declare
    %test:assertEquals(5)
function arr:nested1() {
    let $a := [ [1, 2, 3], [4, 5, 6] ]
    return $a(2)(2)
};

declare
    %test:assertEquals(5)
function arr:nested2() {
    let $a := array { [1, 2, 3], [4, 5, 6] }
    return $a(2)(2)
};

declare
    %test:args(2)
function arr:size1() {
    array:size([
test
, 55])
};

declare
    %test:args(1)
function arr:size2() {
    array:size([[]])
};

declare
    %test:assertEquals(3, 4, 5)
function arr:append1() {
    array:append([1, 2], (3, 4, 5))(3)
};

declare
    %test:assertEmpty
function arr:append2() {
    array:append([1, 2], ())(3)
};

declare
    %test:assertEquals("a")
function arr:head1() {
    array:head(["a", "b"])
};

declare
    %test:assertEquals(2)
function arr:head2() {
    array:head([[1, 2], 3, 4, 5])(2)
};

declare
    %test:assertError("FOAY0001")
function arr:head-empty() {
    array:head([])
};

declare
    %test:assertEquals(2)
function arr:tail1() {
    array:tail([1, 2, 3])(1)
};

declare
    %test:assertEquals(2)
function arr:tail2() {
    array:tail([1, [2, 3]])(1)(1)
};

declare
    %test:assertEquals(0)
function arr:tail3() {
    array:size(array:tail([1]))
};

declare
    %test:assertError("FOAY0001")
function arr:tail-empty() {
    array:tail([])
};

declare
    %test:assertEquals(2, 3)
function arr:tail-on-array() {
    array:tail([1,[2,3]])?*?*
};

declare
    %test:args(2)
    %test:assertEquals("b", "c", "d")
    %test:args(5)
    %test:assertEmpty
function arr:subarray1($start as xs:int) {
    let $a := array:subarray(["a", "b", "c", "d"], $start)
    return
        $a?*
};

declare
    %test:args(5, 0)
    %test:assertEmpty
    %test:args(2, 0)
    %test:assertEmpty
    %test:args(2, 1)
    %test:assertEquals("b")
    %test:args(2, 2)
    %test:assertEquals("b", "c")
    %test:args(4, 1)
    %test:assertEquals("d")
    %test:args(1, 2)
    %test:assertEquals("a", "b")
    %test:args(1, 5)
    %test:assertError("FOAY0001")
    %test:args(0, 1)
    %test:assertError("FOAY0001")
    %test:args(1, "-1")
    %test:assertError("FOAY0002")
function arr:subarray2($start as xs:int, $length as xs:int) {
    let $a := array:subarray(["a", "b", "c", "d"], $start, $length)
    return
        $a?*
};

declare
    %test:args(1)
    %test:assertEquals("b", "c", "d")
    %test:args(2)
    %test:assertEquals("a", "c", "d")
    %test:args(4)
    %test:assertEquals("a", "b", "c")
    %test:args(0)
    %test:assertError("FOAY0001")
    %test:args(5)
    %test:assertError("FOAY0001")
function arr:remove1($pos as xs:int) {
    array:remove(["a", "b", "c", "d"], $pos)?*
};

declare
    %test:assertEmpty
function arr:remove2() {
    array:remove(["a"], 1)?*
};

declare
    %test:assertEquals("d", "c", "b", "a")
function arr:reverse1() {
    array:reverse(["a", "b", "c", "d"])?*
};

declare
    %test:assertEquals("c", "d", "a", "b")
function arr:reverse2() {
    array:reverse([("a", "b"), ("c", "d")])?*
};

declare
    %test:assertEquals("1", "2", "3", "4", "5")
function arr:reverse3() {
    array:reverse([(1 to 5)])?*
};

declare
    %test:assertEmpty
function arr:reverse4() {
    array:reverse([])?*
};

declare
    %test:assertEmpty
function arr:join1() {
    array:join(())?*
};

declare
    %test:assertEquals("a", "b", "c", "d")
function arr:join2() {
    array:join((["a", "b"], ["c", "d"], []))?*
};

declare
    %test:assertEquals(5)
function arr:join3() {
    array:size(array:join((["a", "b"], ["c", "d"], [["e", "f"]])))
};

declare
    %test:assertEquals("A", "B", "C", "D")
function arr:for-each1() {
    array:for-each(["a", "b", "c", "d"], upper-case#1)?*
};

declare
    %test:assertEquals("false", "false", "true", "true")
function arr:for-each2() {
    array:for-each(["a", "b", 1, 2], function($z) { $z instance of xs:integer })?*
};

declare
    %test:assertEquals("1", "2")
function arr:filter1() {
    array:filter(["a", "b", 1, 2], function($z) { $z instance of xs:integer })?*
};

declare
    %test:assertEquals("a", "b", 1)
function arr:filter2() {
    array:filter(["a", "b", "", 0, 1], boolean#1)?*
};

declare
    %test:assertEquals("the cat", "on the mat")
function arr:filter3() {
    array:filter(["the cat", "sat", "on the mat"], function($s) { count(tokenize($s, " ")) gt 1 })?*
};

declare
    %test:assertFalse
function arr:fold-left1() {
    array:fold-left([true(), true(), false()], true(), function($x, $y) { $x and $y })
};

declare
    %test:assertTrue
function arr:fold-left2() {
    array:fold-left([true(), true(), false()], false(), function($x, $y) { $x or $y })
};

declare
    %test:assertEquals(1)
function arr:fold-left3() {
    array:fold-left([], 1, function($x, $y) { $x + $y })
};

declare
    %test:assertEquals(8)
function arr:fold-left4() {
    array:fold-left(["abc", "def", "gh"], 0, function($x, $y) { $x + string-length($y) })
};

declare
    %test:assertEquals("abcdefgh")
function arr:fold-left5() {
    array:fold-left(["abc", "def", "gh"], "", function($x, $y) { $x || $y })
};

declare
    %test:assertEquals(1)
function arr:fold-left6() {
    array:fold-left([1, 2], (), function($x, $y) { [$x, $y] })?1?2
};

declare
    %test:assertFalse
function arr:fold-right1() {
    array:fold-right([true(), true(), false()], true(), function($x, $y) { $x and $y })
};

declare
    %test:assertTrue
function arr:fold-right2() {
    array:fold-right([true(), true(), false()], false(), function($x, $y) { $x or $y })
};

declare
    %test:assertEquals(2)
function arr:fold-right3() {
    array:fold-right([1, 2, 3], (), function($x, $y) { [$x, $y] })?2?1
};

declare
    %test:assertEquals(5, 4, 3, 2, 1)
function arr:fold-right4() {
    array:fold-right(
        array { 1 to 5 },
        (),
        function($a, $b) { $b, $a }
    )
};

declare
    %test:assertEquals("AB", "BC", "CD")
function arr:for-each-pair1() {
    let $a := ["A", "B", "C", "D"]
    return
        array:for-each-pair($a, array:tail($a), concat#2)?*
};

declare
    %test:assertEquals(5, 7, 9)
function arr:for-each-pair2() {
    array:for-each-pair(
        array { 1 to 3 },
        array { 4 to 6 },
        function($a, $b) { $a + $b }
    )?*
};

declare
    %test:assertEmpty
function arr:for-each-pair3() {
    array:for-each-pair(
        [],
        array { 4 to 6 },
        function($a, $b) { $a + $b }
    )?*
};

declare
    %test:assertEquals(1, 4, 6, 5, 3)
function arr:flatten1() {
    array:flatten([1, 4, 6, 5, 3])
};

declare
    %test:assertEquals(1, 2, 5, 10, 11, 12, 13)
function arr:flatten2() {
    array:flatten(([1, 2, 5], [[10, 11], 12], [], 13))
};

declare
    %test:assertEquals(1, 1, 0, 1, 1)
function arr:flatten3() {
    array:flatten((1, [(1, 0), (1, 1)]))
};

declare
    %test:assertEmpty
function arr:flatten4() {
    array:flatten(())
};

declare
    %test:assertEquals("a", "b", "x", "c", "d")
function arr:insert-before1() {
    array:insert-before(["a", "b", "c", "d"], 3, "x")?*
};

declare
    %test:assertEquals("x", "y")
function arr:insert-before2() {
    array:insert-before(["a", "b", "c", "d"], 3, ("x", "y"))?3
};

declare
    %test:assertEquals("a", "b", "c", "d", "x")
function arr:insert-before3() {
    array:insert-before(["a", "b", "c", "d"], 5, "x")?*
};

declare
    %test:assertError("err:FOAY0001")
function arr:insert-before-pos-zero() {
    array:insert-before(["a", "b", "c", "d"], 0, "x")?*
};

declare
    %test:assertError("err:FOAY0001")
function arr:insert-before-pos-illegal-index() {
    array:insert-before(["a", "b", "c", "d"], 6, "x")?*
};

declare
    %test:assertEquals("array")
function arr:array-type1() {
    let $a := [1, 2]
    return
        typeswitch($a)
            case array(*) return
                "array"
            default return
                "no array"
};

declare
    %test:assertEquals("<t>test</t>")
function arr:apply-inline() {
    let $fn := function($a as xs:string, $b as xs:int, $c as element()) {
        $c
    }
    return
        apply($fn, ["a", 1, <t>test</t>])
};

declare
    %test:assertEquals("abc")
function arr:apply-internal() {
    apply(concat#3, ["a", "b", "c"])
};

declare
    %test:assertEquals("a", 1)
function arr:apply-param-array() {
    let $fn := function($a as array(*)) {
        $a?*
    }
    return
        apply($fn, [["a", 1]])
};

declare
    %test:assertEquals("1")
function arr:apply-param-map() {
    let $fn := function($m as map(*)) {
        $m?*
    }
    return
        apply($fn, [map { "key": 1 }])
};

declare
    %test:assertEquals(3)
function arr:apply-param-seq() {
    let $fn := function($s as item()*) {
        count($s)
    }
    return
        apply($fn, [(1, 2, 3)])
};

declare
    %test:assertEquals("HELLO WORLD")
function arr:apply-closure() {
    let $s := "Hello world"
    let $fn := function() {
        upper-case($s)
    }
    return
        apply($fn, [])
};

declare
    %test:args('"a"')
    %test:assertEquals("a")
    %test:args("2")
    %test:assertEquals(2)
    %test:args("true")
    %test:assertTrue
    %test:args("false")
    %test:assertFalse
    %test:args("null")
    %test:assertEmpty
    %test:args("[]")
    %test:assertXPath("array:size($result) = 0")
    %test:args('[1, "a"]')
    %test:assertXPath("$result?2 = 'a'")
    %test:args('[1, ["a", "b"]]')
    %test:assertXPath("$result?2?2 = 'b'")
    %test:args('[1, []]')
    %test:assertXPath("array:size($result?2) = 0")
    %test:args('[1, null]')
    %test:assertXPath("array:size($result) = 2")
    %test:args('{"key1": "val1", "key2": "val2"}')
    %test:assertXPath("$result?key2 = 'val2'")
    %test:args('{"key1": "val1", "key2": [1, 2]}')
    %test:assertXPath("$result?key2?2 = 2")
    %test:args('{"key1": null, "key2": "val2"}')
    %test:assertXPath("empty($result?key1)")
    %test:args('{key: "value"}')
    %test:assertError("FOJS0001")
    %test:args("{key: 'value'}")
    %test:assertError("FOJS0001")
    %test:args('{"k1": "v1", "k1": "v2"}')
    %test:assertXPath("$result?k1 = 'v2'")
function arr:parse-json($json as xs:string) {
    parse-json($json)
};

declare
    %test:args('{key: "value"}')
    %test:assertXPath("$result?key = 'value'")
    %test:args("{'key': 'value'}")
    %test:assertXPath("$result?key = 'value'")
function arr:parse-json-liberal($json as xs:string) {
    parse-json($json, map { "liberal": true() })
};

declare
    %test:args('{"k1": "v1", "k1": "v2"}', "reject")
    %test:assertError("FOJS0003")
    %test:args('{"k1": "v1", "k1": "v2"}', "use-first")
    %test:assertXPath("$result?k1 = 'v1'")
    %test:args('{"k1": "v1", "k1": "v2"}', "use-last")
    %test:assertXPath("$result?k1 = 'v2'")
function arr:parse-json-duplicates($json as xs:string, $duplicates as xs:string) {
    parse-json($json, map { "duplicates": $duplicates })
};

declare
    %test:assertXPath("$result?1?key2 = 'value2'")
function arr:json-doc-db() {
    json-doc("/db/array-test/test.json")
};

declare
    %test:assertError("FOJS0003")
function arr:json-doc-options() {
    json-doc("/db/array-test/test.json", map { "duplicates": "reject" })
};

declare
    %test:assertXPath("$result?1?key2 = 'value2'")
    %test:pending(" Requires running server")
function arr:json-doc-http() {
    json-doc("http://localhost:8080/exist/rest/db/array-test/test.json")
};

declare
    %test:assertError("FOUT1170")
function arr:json-doc-invalid() {
    json-doc("notfound.json")
};

declare
    %test:assertEquals('{"a1":22,"a2":["z","b","c"]}')
function arr:serialize() {
    let $json :=
        map {
            "a1": 22,
            "a2": [ "z", "b", "c" ]
        }
    let $serialized :=
        serialize($json, $arr:SERIALIZE_JSON)
    return
        $serialized
};

declare
    %test:assertTrue
function arr:serialize-roundtrip() {
    let $json :=
        map {
            "k1": 22,
            "k2": [ "z", "b", "c" ],
            "k3": map { "k4": array { 1 to 100 }, "k5": () }
        }
    let $serialized :=
        serialize($json, $arr:SERIALIZE_JSON)
    let $parsed := parse-json($serialized)
    return
        deep-equal($json, $parsed)
};

declare
    %test:assertEquals('{"xml":"

Test

"}')
function arr:serialize-node() {
    let $json :=
        map {
            "xml":

Test

        }
    return
        serialize($json, $arr:SERIALIZE_JSON)
};

declare
    %test:assertEquals('{"status":true}')
function arr:serialize-old-json-compat() {
    let $xmlJson := <result><status json:literal="true">true</status></result>
    return
        serialize($xmlJson, $arr:SERIALIZE_JSON)
};

declare
    %test:assertEquals('{ "status" : true }')
function arr:serialize-old-json-compat-indent() {
    let $xmlJson := <result><status json:literal="true">true</status></result>
    return
        serialize($xmlJson, $arr:SERIALIZE_JSON_INDENT)
};

declare
    %test:args(2)
    %test:assertTrue
    %test:args(3)
    %test:assertTrue
    %test:args(6)
    %test:assertTrue
    %test:args(7)
    %test:assertFalse
function arr:general-comparison1($val as xs:int) {
    [1, 2, 3, [5, 6]] = $val
};

declare
    %test:assertTrue
function arr:general-comparison2() {
    let $xml := <test>2</test>
    return
        $xml/a[. = [2, 3]]
};

declare
    %test:assertFalse
function arr:general-comparison3() {
    let $xml := <test>2</test>
    return
        $xml/a[. = [3, 4]]
};

declare
    %test:assertEquals("1")
function arr:general-comparison-range() {
    collection("/db/array-test")//a[. = [1, 2]]
};

declare
    %test:assertEquals("2")
function arr:general-comparison-range-new() {
    collection("/db/array-test")//b[. = [1, 2]]
};

declare
    %test:assertError
function arr:value-comparison() {
    let $xml := <test>3</test>
    return
        $xml/a[. eq [3, 4]]
};

declare
    %test:assertEquals(1)
function arr:cast-as() {
    array { 1 } cast as xs:double
};

declare
    %test:assertError
function arr:cast-as-invalid() {
    array { 1 to 3 } cast as xs:double
};

declare
    %test:assertEquals(1)
function arr:castable-as() {
    array { 1 } castable as xs:double
};

declare
    %test:assertError
function arr:castable-as-invalid() {
    array { 1 to 3 } castable as xs:double
};

declare
    %test:assertEquals("<test>
Hello world!
</test>")
function arr:enclosed-expr-element() {
    <test>
Hello {[world, "!"]}
</test>
};

declare
    %test:assertEquals("
Hello world !
")
function arr:element-computed() {
    element p {
        "Hello", ["world", "!"]
    }
};

declare
    %test:assertEquals('<test attr="1 2"/>')
function arr:enclosed-expr-attribute() {
    <test attr="{[1, 2]}"/>
};

declare
    %test:assertEquals('
')
function arr:attribute-computed() {
    element p {
        attribute attr { [1, 2] }
    }
};

declare
    %test:assertEquals('
Hello world
')
function arr:text-computed() {
    element p {
        text { ["Hello", "world"] }
    }
};

declare
    %test:assertEquals('

')
function arr:comment-computed() {
    element p {
        comment { ["Hello", "world"] }
    }
};

declare
    %test:assertEquals(1, 2, 3, 4)
function arr:fn-data() {
    data([1, 2, [3, 4]])
};

declare
    %test:assertEquals("a", "b")
function arr:nested-for-each() {
    array:for-each([["a","b"]],function($v){
        array:for-each($v,function($_){
            $_
        })
    })?*?*
};

declare
    %test:assertTrue
function arr:lookupWildcard() {
    let $expected := (1 to array:size($arr:primes)) ! $arr:primes(.)
    let $actual := $arr:primes?*
    return
        count($actual) eq count($expected)
        and
        (every $prime in $actual satisfies $prime = $expected)
};

declare
    %test:assertEquals("x", "b", "c", "d")
function arr:put_pos_first() {
    array:put(["a", "b", "c", "d"], 1, "x")?*
};

declare
    %test:assertEquals("a", "b", "x", "d")
function arr:put_pos_third() {
    array:put(["a", "b", "c", "d"], 3, "x")?*
};

declare
    %test:assertEquals("a", "b", "c", "x")
function arr:put_pos_last() {
    array:put(["a", "b", "c", "d"], 4, "x")?*
};

declare
    %test:assertError("err:FOAY0001")
function arr:put_pos_zero() {
    array:put(["a", "b", "c", "d"], 0, "x")?*
};

declare
    %test:assertError("err:FORG0006")
function arr:put_pos_double() {
    array:put(["a", "b", "c", "d"], 1.5, "x")?*
};

declare
    %test:assertError("err:FOAY0001")
function arr:put_pos_illegal_index() {
    array:put(["a", "b", "c", "d"], 5, "x")?*
};

declare
    %test:assertEquals(1, 3, 4, 5, 6)
function arr:sort-int() {
    array:sort([1, 4, 6, 5, 3])?*
};

declare
    %test:assertEquals("1", "-2", "5", "8", "10", "-10", "10")
function arr:sort-abs() {
    array:sort([1, -2, 5, 10, -10, 10, 8], (), fn:abs#1)?*
};

declare
    %test:assertEquals(0,0, 0,1, 1,0, 1,1)
function arr:sort-seq() {
    array:sort([(1,0), (1,1), (0,1), (0,0)])?*
};

declare
    %test:assertEquals("b", "a", "c")
function arr:sort-node() {
    array:sort([, , <c/>])?* ! local-name(.)
};

declare
    %test:assertError("err:XPTY0004")
function arr:sort-mixed-1() {
    array:sort([4, , 1, <d/>, "22", "2"])?*
};