Add extra xf:select and xf:select-all arity

xquery version "3.0";

(:~
 : Origami templating.
 :
 : @version 0.4
 : @author Marc van Grootel
 : @see https://github.com/xokomola/origami
 :)

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

import module namespace apply = 'http://xokomola.com/xquery/common/apply'
    at 'apply.xqm';

(:~
 : 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))
};

(:~
 : Template data. This is constructed from a transform on the template
 : and executing the slot handlers (match templates) on each matched
 : node from the template.
 :
 : TODO: $tpl should be looked at to determine if fetch or parse should be
 :       invoked (or even doc()).
 :)
declare function xf:template($nodes as node()*, $tpl, $slots as map(*)*)
    as node()* {
    xf:template($tpl, $slots)($nodes)
};

declare function xf:template($tpl, $slots as map(*)*)
    as node()* {
    xf:transform($slots)($tpl)
};

(:~
 : Returns a Transformer function.
 :)
declare function xf:transform($templates as map(*)*)
    as function(node()*) as node()* {
    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 map(*)*)
    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($steps as function(*)*)
    as function(node()*) as node()* {
    xf:extract-outer($steps)
};

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

(:~
 : Returns an extractor function that returns selected nodes,
 : only innermost, in document order and duplicates eliminitated.
 :)
declare function xf:extract-inner($steps as function(*)*)
    as function(node()*) as node()* {
    function($nodes as node()*) as node()* {
        xf:distinct-nodes(innermost(xf:select-nodes($nodes, $steps)))
    }
};

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

(:
 : TODO: when running on 8.0 20141116.135016 or higher then
 :       xf:distinct-nodes() can be removed due to bugfix
 :       remove it after 8.0 is released.
 :)

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

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

(:~
 : TODO
 :
 : 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($selector, $body)
    as map(*)? {
    let $selector := xf:select-all($selector)
    let $body :=
        typeswitch ($body)
        case empty-sequence() return function($node) { () }
        case function(*) return $body
        default return function($node) { $body }
    where $selector instance of function(*) and $body instance of function(*)
    return
        map {
            'select': $selector,
            'fn': $body
        }
};

(:~
 : Define a transformation that starts with selecting nodes with an
 : XPath expression.
 :)
declare function xf:at($selector as xs:string, $xforms as function(*)*)
    as function(node()*) as node()* {
    let $selector := xf:select-all($selector)
    let $xform := xf:do-each($xforms)
    return
        if (exists($xforms)) then
            function($nodes as node()*) as node()* {
                $xform($selector($nodes))
            }
        else
            $selector
};

declare function xf:at($selector as xs:string) {
    xf:at($selector, ())
};

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

(:~
 : 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 function(*)*)
    as function(node()*) as node()* {
    function($nodes as node()*) as node()* {
        fold-left(
            $fns,
            $nodes,
            function($nodes, $fn) {
                $fn($nodes)
            }
        )
    }
};

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

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

(:~
 : Execute a chain of node transformers.
 :)
declare function xf:do-each($nodes as node()*, $fns as function(*)*)
    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)
};

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

(:~
 : Return matching nodes.
 :)
declare %private function xf:select-nodes($nodes as node()*, $selectors as function(*)*)
    as node()* {
    for $selector in $selectors
    return
        for $node in $nodes
        return
            $selector($node)
};

(:~
 : Find the first matching template for a node and return
 : it's node transformation function.
 :)
declare %private function xf:match-node($node as node(), $xform as map(*)*)
    as map(*)? {
    hof:until(
        function($templates as map(*)*) {
            let $is-match := head($templates)
            return
                empty($is-match) or
                ($is-match instance of map(*) and map:contains($is-match,'nodes'))
        },
        function($templates as map(*)*) {
            let $template := head($templates)
            let $matched-nodes := $template('select')($node)
            return
                (
                    if ($matched-nodes) then
                        map:new(($template, map { 'nodes': $matched-nodes }))
                    else
                        ()
                    ,
                    tail($templates)
                )
        },
        $xform
    )[1]
};

(:~
 : Find the first matching template for a node
 : and return a modified template that contains the matched nodes.
 :)
declare %private function xf:match-template($node as node(), $xform as map(*)*)
    as map(*)? {
    hof:until(
        function($templates as map(*)*) {
            let $is-match := head($templates)
            return
                empty($is-match) or
                ($is-match instance of map(*) and map:contains($is-match,'nodes'))
        },
        function($templates as map(*)*) {
            let $template := head($templates)
            let $matched-nodes := $template('select')($node)
            return
                (
                    if ($matched-nodes) then
                        map:new(($template, map { 'nodes': $matched-nodes }))
                    else
                        ()
                    ,
                    tail($templates)
                )
        },
        $xform
    )[1]
};

(:~
 : 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 ($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
        ()
};

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 only distinct nodes.
 : @see http://www.xqueryfunctions.com/xq/functx_distinct-nodes.html
 :)
declare %private function xf:distinct-nodes($nodes as node()*)
    as node()* {
    for $seq in (1 to count($nodes))
    return $nodes[$seq][
        not(xf:is-node-in-sequence(.,$nodes[position() < $seq]))]
};

(:~
 : 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
};

(:~
 : Partition a sequence into an array of sequences $n long.
 : This is used to build rules that consist of a selector (xf:at) and
 : a body (xf:do).
 :
 : NOTE: currently not used
 :)
declare function xf:partition($n as xs:integer, $seq) as array(*)* {
    if (not(empty($seq))) then
        for $i in 1 to (count($seq) idiv $n) + 1
        where count($seq) > ($i -1) * $n
        return
            array { subsequence($seq, (($i -1) * $n) + 1, $n) }
    else
        ()
};

xquery version "3.0";

(:~
 : Origami templating.
 :
 : @version 0.4
 : @author Marc van Grootel
 : @see https://github.com/xokomola/origami
 :)

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

import module namespace apply = 'http://xokomola.com/xquery/common/apply'
    at 'apply.xqm';

(:~
 : 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))
};

(:~
 : Template data. This is constructed from a transform on the template
 : and executing the slot handlers (match templates) on each matched
 : node from the template.
 :
 : TODO: $tpl should be looked at to determine if fetch or parse should be
 :       invoked (or even doc()).
 :)
declare function xf:template($nodes as node()*, $tpl, $slots as map(*)*)
    as node()* {
    xf:template($tpl, $slots)($nodes)
};

declare function xf:template($tpl, $slots as map(*)*)
    as node()* {
    xf:transform($slots)($tpl)
};

(:~
 : Returns a Transformer function.
 :)
declare function xf:transform($templates as map(*)*)
    as function(node()*) as node()* {
    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 map(*)*)
    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($steps as function(*)*)
    as function(node()*) as node()* {
    xf:extract-outer($steps)
};

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

(:~
 : Returns an extractor function that returns selected nodes,
 : only innermost, in document order and duplicates eliminitated.
 :)
declare function xf:extract-inner($steps as function(*)*)
    as function(node()*) as node()* {
    function($nodes as node()*) as node()* {
        xf:distinct-nodes(innermost(xf:select-nodes($nodes, $steps)))
    }
};

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

(:
 : TODO: when running on 8.0 20141116.135016 or higher then
 :       xf:distinct-nodes() can be removed due to bugfix
 :       remove it after 8.0 is released.
 :)

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

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

(:~
 : TODO
 :
 : 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($selector, $body)
    as map(*)? {
    let $selector := xf:select-all($selector)
    let $body :=
        typeswitch ($body)
        case empty-sequence() return function($node) { () }
        case function(*) return $body
        default return function($node) { $body }
    where $selector instance of function(*) and $body instance of function(*)
    return
        map {
            'select': $selector,
            'fn': $body
        }
};

(:~
 : Define a transformation that starts with selecting nodes with an
 : XPath expression.
 :)
declare function xf:at($selector as xs:string, $xforms as function(*)*)
    as function(node()*) as node()* {
    let $selector := xf:select-all($selector)
    let $xform := xf:do-each($xforms)
    return
        if (exists($xforms)) then
            function($nodes as node()*) as node()* {
                $xform($selector($nodes))
            }
        else
            $selector
};

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

declare function xf:at($selector as xs:string) {
    xf:at($selector, ())
};

(:~
 : 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 function(*)*)
    as function(node()*) as node()* {
    function($nodes as node()*) as node()* {
        fold-left(
            $fns,
            $nodes,
            function($nodes, $fn) {
                $fn($nodes)
            }
        )
    }
};

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

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

(:~
 : Execute a chain of node transformers.
 :)
declare function xf:do-each($nodes as node()*, $fns as function(*)*)
    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($selector, xf:environment())
};

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

declare function xf:select($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>
};

(:~
 : Return matching nodes.
 :)
declare %private function xf:select-nodes($nodes as node()*, $selectors as function(*)*)
    as node()* {
    for $selector in $selectors
    return
        for $node in $nodes
        return
            $selector($node)
};

(:~
 : Find the first matching template for a node and return
 : it's node transformation function.
 :)
declare %private function xf:match-node($node as node(), $xform as map(*)*)
    as map(*)? {
    hof:until(
        function($templates as map(*)*) {
            let $is-match := head($templates)
            return
                empty($is-match) or
                ($is-match instance of map(*) and map:contains($is-match,'nodes'))
        },
        function($templates as map(*)*) {
            let $template := head($templates)
            let $matched-nodes := $template('select')($node)
            return
                (
                    if ($matched-nodes) then
                        map:new(($template, map { 'nodes': $matched-nodes }))
                    else
                        ()
                    ,
                    tail($templates)
                )
        },
        $xform
    )[1]
};

(:~
 : Find the first matching template for a node
 : and return a modified template that contains the matched nodes.
 :)
declare %private function xf:match-template($node as node(), $xform as map(*)*)
    as map(*)? {
    hof:until(
        function($templates as map(*)*) {
            let $is-match := head($templates)
            return
                empty($is-match) or
                ($is-match instance of map(*) and map:contains($is-match,'nodes'))
        },
        function($templates as map(*)*) {
            let $template := head($templates)
            let $matched-nodes := $template('select')($node)
            return
                (
                    if ($matched-nodes) then
                        map:new(($template, map { 'nodes': $matched-nodes }))
                    else
                        ()
                    ,
                    tail($templates)
                )
        },
        $xform
    )[1]
};

(:~
 : 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 ($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
        ()
};

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 only distinct nodes.
 : @see http://www.xqueryfunctions.com/xq/functx_distinct-nodes.html
 :)
declare %private function xf:distinct-nodes($nodes as node()*)
    as node()* {
    for $seq in (1 to count($nodes))
    return $nodes[$seq][
        not(xf:is-node-in-sequence(.,$nodes[position() < $seq]))]
};

(:~
 : 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
};

(:~
 : Partition a sequence into an array of sequences $n long.
 : This is used to build rules that consist of a selector (xf:at) and
 : a body (xf:do).
 :
 : NOTE: currently not used
 :)
declare function xf:partition($n as xs:integer, $seq) as array(*)* {
    if (not(empty($seq))) then
        for $i in 1 to (count($seq) idiv $n) + 1
        where count($seq) > ($i -1) * $n
        return
            array { subsequence($seq, (($i -1) * $n) + 1, $n) }
    else
        ()
};


remvoved extraneous active heading for the csr endpoints

module namespace page = 'http://basex.org/modules/web-page';

import module namespace csr_proc = "https://github.com/his-interop/openinfoman/csr_proc" at "../repo/csr_processor.xqm";
import module namespace csd_dm = "https://github.com/his-interop/openinfoman/csd_dm" at "../repo/csd_document_manager.xqm";
import module namespace csd_webconf =  "https://github.com/his-interop/openinfoman/csd_webconf" at "../repo/csd_webapp_config.xqm";

declare   namespace   csd = "urn:ihe:iti:csd:2013";
declare default element  namespace   "urn:ihe:iti:csd:2013";
declare   namespace   xforms = "http://www.w3.org/2002/xforms";
declare namespace xs = "http://www.w3.org/2001/XMLSchema";

declare variable $page:csd_docs := csd_dm:registered_documents($csd_webconf:db);

declare
  %rest:path("/CSD/csr/{$name}/careServicesRequest")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST("{$careServicesRequest}")
  function page:csr($name,$careServicesRequest)
{
if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
 csr_proc:process_CSR($careServicesRequest/careServicesRequest,csd_dm:open_document($csd_webconf:db,$name))
else
  (:need appropriate error handling:)
  ()

};

declare updating
  %rest:path("/CSD/csr/{$name}/careServicesRequest/update")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST("{$careServicesRequest}")
  function page:csr_updating($name,$careServicesRequest)
{
if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
 csr_proc:process_updating_CSR($careServicesRequest/careServicesRequest,csd_dm:open_document($csd_webconf:db,$name))
else
  (:need appropriate error handling:)
  ()

};

declare
  %rest:path("/CSD/csr/{$name}/adhoc")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST
  %rest:form-param("adhoc","{$adhoc}")
  %rest:form-param("content", "{$content}","application/xml")
function page:adhoc($name,$adhoc,$content) {
if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
(:  csr_proc:process_CSR_adhoc(fn:parse-xml($adhoc),csd_dm:open_document($csd_webconf:db,$name)) :)
let  $adhoc_doc := csr_proc:create_adhoc_doc(string($adhoc),$content)
return  csr_proc:process_CSR($adhoc_doc,csd_dm:open_document($csd_webconf:db,$name))
(:
  return  csr_proc:process_CSR($adhoc_doc,csd_dm:open_document($csd_webconf:db,$name))      :)
else
  (:need appropriate error handling:)
  ()

};

declare function page:function_list()  {

Care Services Request - Stored Queries

      {
      for $function in ($csd_webconf:stored_functions,$csd_webconf:stored_updating_functions)
      let  $uuid := string($function/@uuid)
      order by $function/@uuid
      return

      UUID: {string($uuid)}

      Method:

{string($function/definition)}

      Content: {string(csd_webconf:lookup_stored_content_type($uuid)) }
      Description:
{$function/description/*}

      Instance:

{serialize($function/xforms:instance/careServicesRequest,map{'indent':='yes'})}

      {if (exists($function/xs:schema)) then  ("Schema: ",string($function/xs:schema),
) else () }
      {if (count( $function/xforms:bind) > 0) then
       ("Bindings: ",

           {for $bind in $function/xforms:bind return
Node set: {string($bind/@nodeset)}
Type: {string($bind/@type)}
}

       ) else ()
       }

      }

};

declare
  %rest:path("/CSD/csr")
  %rest:GET
  %output:method("xhtml")
  function page:csr_list()
{
let $list := page:function_list()
let $response := page:endpoints()
return page:wrapper($list,$response)
};

declare function page:wrapper($list,$requests) {

    <link href="{$csd_webconf:baseurl}static/bootstrap/css/bootstrap.css" rel="stylesheet"/>
    <link href="{$csd_webconf:baseurl}static/bootstrap/css/bootstrap-theme.css" rel="stylesheet"/>

          <button type="button" class="navbar-toggle" data-toggle="collapse" data-target=".navbar-collapse">

          </button>
          OpenInfoMan

Available Functions

careServiceRequest Endpoints

{$list}

{$requests}

};

declare function page:endpoints() {

Care Services Request - Endpoints

      {
	for $name in $page:csd_docs
	return

	  Submit Care Services Request for {$name} at:

{$csd_webconf:baseurl}//CSD/csr/{$name}/careServicesRequest

	  Submit ad-hoc query:
	  <form method='post' action="/CSD/csr/{$name}/adhoc"  enctype="multipart/form-data">
	    Ad-Hoc Query<textarea  rows="10" cols="80" name="adhoc" >{$page:sample}</textarea>

	    Content Type<input    cols="80" name="content" value="text/html"/>

	    <input type="submit" value="submit"/>
	  </form>

      }

};

declare variable $page:sample :=
"

You have {count(/csd:CSD/csd:providerDirectory/*)} providers.

You have {count(/csd:CSD/csd:facilityDirectory/*)} facilities.

You have {count(/csd:CSD/csd:organizationDirectory/*)} organizations.

You have {count(/csd:CSD/csd:serviceDirectory/*)} services.

";


fixed restxq GET for csr/<DOC>/careServicesRequest

module namespace page = 'http://basex.org/modules/web-page';

import module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace csd_webui =  "https://github.com/openhie/openinfoman/csd_webui";

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

declare variable $page:csd_docs := csd_dm:registered_documents($csd_webconf:db);

declare
  %rest:path("/CSD/csr/{$name}/careServicesRequest")
  %rest:POST("{$careServicesRequest}")
  function page:csr($name,$careServicesRequest)
{
if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
 csr_proc:process_CSR($csd_webconf:db,$careServicesRequest/careServicesRequest,$name,csd_webui:generateURL())
else
  (:need appropriate error handling:)
  ()

};

declare
  %rest:path("/CSD/csr/{$name}/careServicesRequest/{$search}")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST("{$requestParams}")
  function page:csr2($name,$requestParams,$search)
{
let $careServicesRequest :=
  <csd:careServicesRequest>
    <csd:function urn="{$search}">{$requestParams}</csd:function>
  </csd:careServicesRequest>
return
  if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
    csr_proc:process_CSR($csd_webconf:db,$careServicesRequest,$name,csd_webui:generateURL())
  else
    (:need appropriate error handling:)
  ()

};

declare updating
  %rest:path("/CSD/csr/{$name}/careServicesRequest/update")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST("{$careServicesRequest}")
  function page:csr_updating($name,$careServicesRequest)
{
  if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
    csr_proc:process_updating_CSR($csd_webconf:db,$careServicesRequest/csd:careServicesRequest,$name,csd_webui:generateURL())
  else
    (:need appropriate error handling:)
    ()
};

declare updating
  %rest:path("/CSD/csr/{$name}/careServicesRequest/update/{$search}")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST("{$requestParams}")
  function page:csr_updating($name,$requestParams,$search)
{
let $careServicesRequest :=
  <csd:careServicesRequest>
    <csd:function urn="{$search}">{$requestParams}</csd:function>
  </csd:careServicesRequest>
return
if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
 csr_proc:process_updating_CSR($csd_webconf:db,$careServicesRequest,$name,csd_webui:generateURL())
else
  (:need appropriate error handling:)
  ()

};

declare
  %rest:path("/CSD/csr/{$name}/adhoc")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST
  %rest:form-param("adhoc","{$adhoc}")
  %rest:form-param("content", "{$content}","application/xml")
function page:adhoc($name,$adhoc,$content) {
if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
let  $adhoc_doc := csr_proc:create_adhoc_doc(string($adhoc),$content)
  return  csr_proc:process_CSR($csd_webconf:db, $adhoc_doc,$name,csd_webui:generateURL())
else
  (:need appropriate error handling:)
  ()

};

declare
  %rest:path("/CSD/csr")
  %rest:GET
  %output:method("xhtml")
  function page:csr_list()
{
let $response := page:endpoints()
return csd_webui:wrapper($response)
};

declare
  %rest:path("/CSD/csr/{$name}/careServicesRequest")
  %rest:GET
  %output:method("xhtml")
  function page:csr($name)
{
  let $contents :=
    (

      Example Usage:

curl -X POST -H 'content-type: text/xml'  --data-binary @request.xml $URL

      where $URL is one of the below and request.xml is an XML file containing a <csd:requestParams/> element

    ,

{
    (
      for $function in csr_proc:stored_functions($csd_webconf:db)
      let $url := csd_webui:generateURL(("CSD/csr", $name , "careServicesRequest", string($function/@urn)))
      return

Name: {string($function/@urn)}

URL: {$url}

Full Description

      ,
      for $function in csr_proc:stored_updating_functions($csd_webconf:db)
      let $url := csd_webui:generateURL(("CSD/csr", $name , "careServicesRequest/update", string($function/@urn)))
      return

Name: {string($function/@urn)} (updating)

URL: {$url}

Full Description

    )
    }

    )
  return csd_webui:wrapper($contents)
};

declare function page:endpoints() {

Care Services Request - Endpoints

      {
	for $name in $page:csd_docs
	return

	  Submit Care Services Request for {$name} at:

{csd_webui:generateURL(('CSD/csr/',$name,'/careServicesRequest'))}

	  Submit ad-hoc query:
	  <form method='post' action="/CSD/csr/{$name}/adhoc"  enctype="multipart/form-data">
	    Ad-Hoc Query<textarea  rows="10" cols="80" name="adhoc" >{$page:sample}</textarea>

	    Content Type<input    cols="80" name="content" value="text/html"/>

	    <input type="submit" value="submit"/>
	  </form>

      }

};

declare variable $page:sample :=
"declare namespace csd = 'urn:ihe:iti:csd:2013';

You have {count(/csd:CSD/csd:providerDirectory/*)} providers.

You have {count(/csd:CSD/csd:facilityDirectory/*)} facilities.

You have {count(/csd:CSD/csd:organizationDirectory/*)} organizations.

You have {count(/csd:CSD/csd:serviceDirectory/*)} services.

";

module namespace page = 'http://basex.org/modules/web-page';

import module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace csd_webui =  "https://github.com/openhie/openinfoman/csd_webui";

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

declare variable $page:csd_docs := csd_dm:registered_documents($csd_webconf:db);

declare
  %rest:path("/CSD/csr/{$name}/careServicesRequest")
  %rest:POST("{$careServicesRequest}")
  function page:csr($name,$careServicesRequest)
{
if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
 csr_proc:process_CSR($csd_webconf:db,$careServicesRequest/careServicesRequest,$name,csd_webui:generateURL())
else
  (:need appropriate error handling:)
  ()

};

declare
  %rest:path("/CSD/csr/{$name}/careServicesRequest/{$search}")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST("{$requestParams}")
  function page:csr2($name,$requestParams,$search)
{
let $careServicesRequest :=
  <csd:careServicesRequest>
    <csd:function urn="{$search}">{$requestParams}</csd:function>
  </csd:careServicesRequest>
return
  if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
    csr_proc:process_CSR($csd_webconf:db,$careServicesRequest,$name,csd_webui:generateURL())
  else
    (:need appropriate error handling:)
  ()

};

declare updating
  %rest:path("/CSD/csr/{$name}/careServicesRequest/update")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST("{$careServicesRequest}")
  function page:csr_updating($name,$careServicesRequest)
{
  if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
    csr_proc:process_updating_CSR($csd_webconf:db,$careServicesRequest/csd:careServicesRequest,$name,csd_webui:generateURL())
  else
    (:need appropriate error handling:)
    ()
};

declare updating
  %rest:path("/CSD/csr/{$name}/careServicesRequest/update/{$search}")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST("{$requestParams}")
  function page:csr_updating($name,$requestParams,$search)
{
let $careServicesRequest :=
  <csd:careServicesRequest>
    <csd:function urn="{$search}">{$requestParams}</csd:function>
  </csd:careServicesRequest>
return
if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
 csr_proc:process_updating_CSR($csd_webconf:db,$careServicesRequest,$name,csd_webui:generateURL())
else
  (:need appropriate error handling:)
  ()

};

declare
  %rest:path("/CSD/csr/{$name}/adhoc")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST
  %rest:form-param("adhoc","{$adhoc}")
  %rest:form-param("content", "{$content}","application/xml")
function page:adhoc($name,$adhoc,$content) {
if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
let  $adhoc_doc := csr_proc:create_adhoc_doc(string($adhoc),$content)
  return  csr_proc:process_CSR($csd_webconf:db, $adhoc_doc,$name,csd_webui:generateURL())
else
  (:need appropriate error handling:)
  ()

};

declare
  %rest:path("/CSD/csr")
  %rest:GET
  %output:method("xhtml")
  function page:csr_list()
{
let $response := page:endpoints()
return csd_webui:wrapper($response)
};

declare
  %rest:path("/CSD/csr/{$name}/careServicesRequest")
  %output:method("xhtml")
  function page:csr($name)
{
  let $contents :=
    (

      Example Usage:

curl -X POST -H 'content-type: text/xml'  --data-binary @request.xml $URL

      where $URL is one of the below and request.xml is an XML file containing a <csd:requestParams/> element

    ,

{
    (
      for $function in csr_proc:stored_functions($csd_webconf:db)
      let $url := csd_webui:generateURL(("CSD/csr", $name , "careServicesRequest", string($function/@urn)))
      return

Name: {string($function/@urn)}

URL: {$url}

Full Description

      ,
      for $function in csr_proc:stored_updating_functions($csd_webconf:db)
      let $url := csd_webui:generateURL(("CSD/csr", $name , "careServicesRequest/update", string($function/@urn)))
      return

Name: {string($function/@urn)} (updating)

URL: {$url}

Full Description

    )
    }

    )
  return csd_webui:wrapper($contents)
};

declare function page:endpoints() {

Care Services Request - Endpoints

      {
	for $name in $page:csd_docs
	return

	  Submit Care Services Request for {$name} at:

{csd_webui:generateURL(('CSD/csr/',$name,'/careServicesRequest'))}

	  Submit ad-hoc query:
	  <form method='post' action="/CSD/csr/{$name}/adhoc"  enctype="multipart/form-data">
	    Ad-Hoc Query<textarea  rows="10" cols="80" name="adhoc" >{$page:sample}</textarea>

	    Content Type<input    cols="80" name="content" value="text/html"/>

	    <input type="submit" value="submit"/>
	  </form>

      }

};

declare variable $page:sample :=
"declare namespace csd = 'urn:ihe:iti:csd:2013';

You have {count(/csd:CSD/csd:providerDirectory/*)} providers.

You have {count(/csd:CSD/csd:facilityDirectory/*)} facilities.

You have {count(/csd:CSD/csd:organizationDirectory/*)} organizations.

You have {count(/csd:CSD/csd:serviceDirectory/*)} services.

";


[ignore] view files' size as B, KB, MB

[ignore] view files' size as B, KB, MB

TODO: replace round by round 2 after point

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

xquery version "1.0";

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

import module namespace json="http://www.json.org";

declare function script:showSubCollections() as element() {
	let $parentCollection := request:get-parameter("collection", "")
	let $subCollections := xmldb:get-child-collections($parentCollection)
	return
	{
		for $collection in $subCollections
		return

				<title>{$collection}</title>
				<isFolder>true</isFolder>
				<isLazy>true</isLazy>
				<key>{concat($parentCollection, "/", $collection)}</key>
			}

};

declare function script:showSubResources() as element() {
	let $parentCollection := request:get-parameter("collection", "")
	let $subResources := xmldb:get-child-resources($parentCollection)
	return

				File
				Size

			{
			for $resource in $subResources
			return

				{$resource}
				{let $size := xmldb:size($parentCollection, $resource)
				return
					if ($size le 1024) then
						{$size} B
					else
						let $size := round($size div 1024)
						return
						if ($size le 1024) then
							{$size} KB
						else
							{round($size div 1024)} MB
				}

			}

};

let $action := request:get-parameter("action", "")
return
	if($action eq "showSubCollections") then
		let $xml := script:showSubCollections()
		let $json := json:xml-to-json($xml)
		let $sLenght := string-length($json)-7
		return
			if(substring($json, 7, $sLenght) eq "") then "[]"
			else substring($json, 7, $sLenght)
	else if($action eq "showCollectionResources") then
		script:showSubResources()
	else()

xquery version "1.0";

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

import module namespace json="http://www.json.org";

declare function script:showSubCollections() as element() {
	let $parentCollection := request:get-parameter("collection", "")
	let $subCollections := xmldb:get-child-collections($parentCollection)
	return
	{
		for $collection in $subCollections
		return

				<title>{$collection}</title>
				<isFolder>true</isFolder>
				<isLazy>true</isLazy>
				<key>{concat($parentCollection, "/", $collection)}</key>
			}

};

declare function script:showSubResources() as element() {
	let $parentCollection := request:get-parameter("collection", "")
	let $subResources := xmldb:get-child-resources($parentCollection)
	return

				File
				Size

			{
			for $resource in $subResources
			return

				{$resource}
				{let $size := xmldb:size($parentCollection, $resource)
				return
					if ($size le 1024) then
						{round($size div 1024)} KB
					else
						{$size} B	}

			}

};

let $action := request:get-parameter("action", "")
return
	if($action eq "showSubCollections") then
		let $xml := script:showSubCollections()
		let $json := json:xml-to-json($xml)
		let $sLenght := string-length($json)-7
		return
			if(substring($json, 7, $sLenght) eq "") then "[]"
			else substring($json, 7, $sLenght)
	else if($action eq "showCollectionResources") then
		script:showSubResources()
	else()


update version and location

update version and location

declare namespace _ = "http://xqerl.org/xquery/test_cases";

declare default element namespace 'http://www.w3.org/2012/08/qt-fots-results';

declare option output:method 'html';

declare variable $_:VERSION := '0.8.0';
declare variable $_:NAME := 'Zachary Dean';
declare variable $_:EMAIL := 'contact@zadean.com';
declare variable $_:OUTPUT :=
  '/git/zadean/xqerl/test/results/results_xqerl_'||$_:VERSION||'.xml';

declare variable $_:catalog := doc("/git/zadean/qt3tests/catalog.xml");
declare variable $_:test-sets := $_:catalog/*:catalog/*:test-set/@name/string();

declare variable $_:test-map :=
  ($_:test-sets ! map:entry(_:mask-name(.), .)) => map:merge();

declare variable $_:supported :=
  (: map of what is or is not supported :)
  map{
    'calendar' : map{
      'CB' : false()
    },
    'default-language' : map{
      'en' : true(),
      'fr-CA' : false()
    },
    'feature' : map{
      'advanced-uca-fallback' : false(),
      'arbitraryPrecisionDecimal' : true(),
      'collection-stability' : true(),
      'directory-as-collection-uri' : false(),
      'fn-format-integer-CLDR' : true(),
      'fn-load-xquery-module' : true(),
      'fn-transform-XSLT' : false(),
      'fn-transform-XSLT30' : false(),
      'higherOrderFunctions' : true(),
      'infoset-dtd' : true(),
      'moduleImport' : true(),
      'namespace-axis' : false(),
      'non_empty_sequence_collection' : true(),
      'non_unicode_codepoint_collation' : true(),
      'olson-timezone' : false(),
      'remote_http' : false(),
      'schema-location-hint' : false(),
      'schemaImport' : false(),
      'schemaValidation' : false(),
      'serialization' : true(),
      'simple-uca-fallback' : true(),
      'staticTyping' : false(),
      'typedData' : false(),
      'xpath-1.0-compatibility' : false()
    },
    'format-integer-sequence' : map{
      'Α' : false(),
      'α' : false(),
      '١' : true(),
      '①' : true(),
      '⑴' : true(),
      '⒈' : true(),
      '一' : false(),
      'ﯴ' : false()
    },
    'language' : map{
      'de' : false(),
      'en' : true(),
      'fr' : false(),
      'it' : false(),
      'xib' : false()
    },
    'limits' : map{
      'year_lt_0' : true()
    },
    'spec' : map{
      'XP20' : false(),
      'XP20 XP30 XQ10 XQ30' : false(),
      'XP20 XQ10' : false(),
      'XP20 XQ10 XP30 XQ30' : false(),
      'XP20+'       : false(),
      'XP20+ XQ10+' : true(),
      'XP30 XQ30'   : false(),
      'XP30+'       : false(),
      'XP30+ XQ10+' : true(),
      'XP30+ XQ30+' : true(),
      'XP31 XQ31'   : true(),
      'XP31+'       : false(),
      'XP31+ XQ31'  : true(),
      'XP31+ XQ31+' : true(),
      'XP31+ XQ31+ XT30+' : true(),
      'XQ10'        : false(),
      'XQ10 XP20' : false(),
      'XQ10 XP20 XQ30 XP30' : false(),
      'XQ10 XQ30' : false(),
      'XQ10+' : true(),
      'XQ10+ XP20+' : true(),
      'XQ10+ XP30+' : true(),
      'XQ30' : false(),
      'XQ30 XP30' : false(),
      'XQ30+' : true(),
      'XQ30+ XP30+' : true(),
      'XQ31' : true(),
      'XQ31+' : true(),
      'XQ31+ XP31+' : true()
    },
    'unicode-normalization-form' : map{
      'FULLY-NORMALIZED' : false(),
      'NFD' : true(),
      'NFKC' : true(),
      'NFKD' : true()
    },
    'unicode-version' : map{
      '3.1.1' : false(),
      '5.2' : false(),
      '6.0' : false(),
      '6.2' : false(),
      '7.0' : false()
    },
    'xml-version' : map{
      '1.0' : true(),
      '1.0:4-' : false(),
      '1.0:5+ 1.1' : true(),
      '1.1' : false()
    },
    'xsd-version' : map{
      '1.0' : true(),
      '1.1' : false()
    }
  };

declare function _:mask-name($text as xs:string) as xs:string
{
  $text => replace('-','_','q')
        => replace(".","_",'q') || '_SUITE'
};

declare function _:submission()
{
  let $subdate := current-date() => fn:adjust-date-to-timezone(())
  return
  <submission anonymous="false">
    <created by="{$_:NAME}" email="{$_:EMAIL}" organization="xqerl" on="{$subdate}"/>
    <test-run test-suite-version="GitHub" date-run="{$subdate}"/>
    <notes/>
  </submission>
};

declare function _:product()
{
  <product vendor="xqerl"
           name="xqerl"
           version="{$_:VERSION}"
           released="true"
           open-source="true"
           language="XQ31">{
      _:dependencies()
  }</product>
};

declare function _:dependencies()
{
  for $t in map:keys($_:supported)
  where $t != 'spec'
  let $tm := $_:supported($t)
  for $v in map:keys($tm)
  let $s := $tm($v)
  order by $t, $v
  return
    <dependency type="{$t}" value="{$v}" satisfied="{$s}"/>
};

declare function _:suite-results($tableBody, $testname)
{
  <test-set name="{$testname}">
  {
    for $row in $tableBody/*:tr[*:td[1] ne ""]
    let $name := $row/*:td[4] => data()
    (: let $time := $row/*:td[6] => data() :)
    let $stat := $row/*:td[7] => data()
    let $mess := $row/*:td[8] => data()
    return
    _:format-result($name, $stat, $mess)
  }
  </test-set>
};

declare function _:format-result($name0, $stat, $message)
{
  let $name := $name0 => replace("'", "")
  return
  if ($stat eq 'Ok') then
    if (starts-with($message, 'WE: ')) then
      let $g := $message => substring-after('WE: ') => tokenize()
      return
      <test-case name="{$name}"
                 result="wrongError"
                 comment="Expected {$g[1]} got {$g[2]}"/>
    else
      <test-case name="{$name}" result="pass"/>
  else if ($stat eq 'SKIPPED') then
    if (starts-with($message, 'TB * ')) then
      <test-case name="{$name}"
                 result="tooBig"
                 comment="{$message => substring-after('TB * ')}"/>
    else
      <test-case name="{$name}" result="n/a" comment="{$message}"/>
  else (: FAILED :)
    <test-case name="{$name}" result="fail"
               comment="Incorrect results"/>
};

declare function _:nvl($value, $default)
{
  if (empty($value)) then
    $default
  else
    $value
};

let $data :=
<test-suite-result>{
  _:submission(),
  _:product(),

  let $base := 'file:///C:/git/zadean/xqerl/test/logs/'
  let $main := html:parse(
    file:read-text($base || 'index.html')
  )
  let $tabBod := $main//*:table[@id = 'SortableTable']/*:tbody
  for $row in $tabBod/*:tr
  let $name := $row/*:td[1] => data() => substring-after('zadean.xqerl.')
  let $testname := $_:test-map($name)
  where not(empty($testname)) (: other tests :)
  let $pass := $row/*:td[4] => data() => xs:integer()
  let $fail := $row/*:td[5] => data() => xs:integer()
  let $skip := $row/*:td[6] => data() => substring-before(' ') => xs:integer()
  let $total := $pass + $fail
  let $link := $base || $row/*:td[1]/*:a/@href
  let $tests := file:read-text($link) => html:parse()
  let $results := $tests//*:table[@id = 'SortableTable']/*:tbody =>  _:suite-results($testname)
  order by $name
  return
  (
    (: comment { 'pass:' || $pass || ' fail:' || $fail || ' skip:' || $skip }, :)
    $results
  )
}</test-suite-result>
return
file:write($_:OUTPUT, $data, map{'method' : 'xml', 'omit-xml-declaration' : 'no'})

declare namespace _ = "http://xqerl.org/xquery/test_cases";

declare default element namespace 'http://www.w3.org/2012/08/qt-fots-results';

declare option output:method 'html';

declare variable $_:VERSION := 0.8;
declare variable $_:NAME := 'Zachary Dean';
declare variable $_:EMAIL := 'contact@zadean.com';
declare variable $_:OUTPUT :=
  '/git/zadean/qt3tests/results/result-submissions-31/results_xqerl_'||$_:VERSION||'.xml';

declare variable $_:catalog := doc("/git/zadean/qt3tests/catalog.xml");
declare variable $_:test-sets := $_:catalog/*:catalog/*:test-set/@name/string();

declare variable $_:test-map :=
  ($_:test-sets ! map:entry(_:mask-name(.), .)) => map:merge();

declare variable $_:supported :=
  (: map of what is or is not supported :)
  map{
    'calendar' : map{
      'CB' : false()
    },
    'default-language' : map{
      'en' : true(),
      'fr-CA' : false()
    },
    'feature' : map{
      'advanced-uca-fallback' : false(),
      'arbitraryPrecisionDecimal' : true(),
      'collection-stability' : true(),
      'directory-as-collection-uri' : false(),
      'fn-format-integer-CLDR' : true(),
      'fn-load-xquery-module' : true(),
      'fn-transform-XSLT' : false(),
      'fn-transform-XSLT30' : false(),
      'higherOrderFunctions' : true(),
      'infoset-dtd' : true(),
      'moduleImport' : true(),
      'namespace-axis' : false(),
      'non_empty_sequence_collection' : true(),
      'non_unicode_codepoint_collation' : true(),
      'olson-timezone' : false(),
      'remote_http' : false(),
      'schema-location-hint' : false(),
      'schemaImport' : false(),
      'schemaValidation' : false(),
      'serialization' : true(),
      'simple-uca-fallback' : true(),
      'staticTyping' : false(),
      'typedData' : false(),
      'xpath-1.0-compatibility' : false()
    },
    'format-integer-sequence' : map{
      'Α' : false(),
      'α' : false(),
      '١' : true(),
      '①' : true(),
      '⑴' : true(),
      '⒈' : true(),
      '一' : false(),
      'ﯴ' : false()
    },
    'language' : map{
      'de' : false(),
      'en' : true(),
      'fr' : false(),
      'it' : false(),
      'xib' : false()
    },
    'limits' : map{
      'year_lt_0' : true()
    },
    'spec' : map{
      'XP20' : false(),
      'XP20 XP30 XQ10 XQ30' : false(),
      'XP20 XQ10' : false(),
      'XP20 XQ10 XP30 XQ30' : false(),
      'XP20+'       : false(),
      'XP20+ XQ10+' : true(),
      'XP30 XQ30'   : false(),
      'XP30+'       : false(),
      'XP30+ XQ10+' : true(),
      'XP30+ XQ30+' : true(),
      'XP31 XQ31'   : true(),
      'XP31+'       : false(),
      'XP31+ XQ31'  : true(),
      'XP31+ XQ31+' : true(),
      'XP31+ XQ31+ XT30+' : true(),
      'XQ10'        : false(),
      'XQ10 XP20' : false(),
      'XQ10 XP20 XQ30 XP30' : false(),
      'XQ10 XQ30' : false(),
      'XQ10+' : true(),
      'XQ10+ XP20+' : true(),
      'XQ10+ XP30+' : true(),
      'XQ30' : false(),
      'XQ30 XP30' : false(),
      'XQ30+' : true(),
      'XQ30+ XP30+' : true(),
      'XQ31' : true(),
      'XQ31+' : true(),
      'XQ31+ XP31+' : true()
    },
    'unicode-normalization-form' : map{
      'FULLY-NORMALIZED' : false(),
      'NFD' : true(),
      'NFKC' : true(),
      'NFKD' : true()
    },
    'unicode-version' : map{
      '3.1.1' : false(),
      '5.2' : false(),
      '6.0' : false(),
      '6.2' : false(),
      '7.0' : false()
    },
    'xml-version' : map{
      '1.0' : true(),
      '1.0:4-' : false(),
      '1.0:5+ 1.1' : true(),
      '1.1' : false()
    },
    'xsd-version' : map{
      '1.0' : true(),
      '1.1' : false()
    }
  };

declare function _:mask-name($text as xs:string) as xs:string
{
  $text => replace('-','_','q')
        => replace(".","_",'q') || '_SUITE'
};

declare function _:submission()
{
  let $subdate := current-date() => fn:adjust-date-to-timezone(())
  return
  <submission anonymous="false">
    <created by="{$_:NAME}" email="{$_:EMAIL}" organization="xqerl" on="{$subdate}"/>
    <test-run test-suite-version="GitHub" date-run="{$subdate}"/>
    <notes/>
  </submission>
};

declare function _:product()
{
  <product vendor="xqerl"
           name="xqerl"
           version="{$_:VERSION}"
           released="true"
           open-source="true"
           language="XQ31">{
      _:dependencies()
  }</product>
};

declare function _:dependencies()
{
  for $t in map:keys($_:supported)
  where $t != 'spec'
  let $tm := $_:supported($t)
  for $v in map:keys($tm)
  let $s := $tm($v)
  order by $t, $v
  return
    <dependency type="{$t}" value="{$v}" satisfied="{$s}"/>
};

declare function _:suite-results($tableBody, $testname)
{
  <test-set name="{$testname}">
  {
    for $row in $tableBody/*:tr[*:td[1] ne ""]
    let $name := $row/*:td[4] => data()
    (: let $time := $row/*:td[6] => data() :)
    let $stat := $row/*:td[7] => data()
    let $mess := $row/*:td[8] => data()
    return
    _:format-result($name, $stat, $mess)
  }
  </test-set>
};

declare function _:format-result($name0, $stat, $message)
{
  let $name := $name0 => replace("'", "")
  return
  if ($stat eq 'Ok') then
    if (starts-with($message, 'WE: ')) then
      let $g := $message => substring-after('WE: ') => tokenize()
      return
      <test-case name="{$name}"
                 result="wrongError"
                 comment="Expected {$g[1]} got {$g[2]}"/>
    else
      <test-case name="{$name}" result="pass"/>
  else if ($stat eq 'SKIPPED') then
    if (starts-with($message, 'TB * ')) then
      <test-case name="{$name}"
                 result="tooBig"
                 comment="{$message => substring-after('TB * ')}"/>
    else
      <test-case name="{$name}" result="n/a" comment="{$message}"/>
  else (: FAILED :)
    <test-case name="{$name}" result="fail"
               comment="Incorrect results"/>
};

declare function _:nvl($value, $default)
{
  if (empty($value)) then
    $default
  else
    $value
};

let $data :=
<test-suite-result>{
  _:submission(),
  _:product(),

  let $base := 'file:///C:/git/zadean/xqerl/test/logs/'
  let $main := html:parse(
    file:read-text($base || 'index.html')
  )
  let $tabBod := $main//*:table[@id = 'SortableTable']/*:tbody
  for $row in $tabBod/*:tr
  let $name := $row/*:td[1] => data() => substring-after('zadean.xqerl.')
  let $testname := $_:test-map($name)
  where not(empty($testname)) (: other tests :)
  let $pass := $row/*:td[4] => data() => xs:integer()
  let $fail := $row/*:td[5] => data() => xs:integer()
  let $skip := $row/*:td[6] => data() => substring-before(' ') => xs:integer()
  let $total := $pass + $fail
  let $link := $base || $row/*:td[1]/*:a/@href
  let $tests := file:read-text($link) => html:parse()
  let $results := $tests//*:table[@id = 'SortableTable']/*:tbody =>  _:suite-results($testname)
  order by $name
  return
  (
    (: comment { 'pass:' || $pass || ' fail:' || $fail || ' skip:' || $skip }, :)
    $results
  )
}</test-suite-result>
return
file:write($_:OUTPUT, $data, map{'method' : 'xml', 'omit-xml-declaration' : 'no'})