Code reformatting

Code reformatting

xquery version "3.1";
module namespace o = 'http://xokomola.com/xquery/origami';

import module namespace u = 'http://xokomola.com/xquery/origami/utils'
    at 'utils.xqm';

declare %private variable $o:e := xs:QName('o:element');
declare %private variable $o:d := xs:QName('o:data');
declare %private variable $o:ns := o:ns();
declare %private variable $o:handler-att := '@';
declare %private variable $o:data-att := '!';
declare %private variable $o:is-element := true();
declare %private variable $o:is-handler := false();
declare %private variable $o:internal-att := ($o:data-att,$o:handler-att);

(: Reading from external entities :)

declare function o:read-xml($uri as xs:string)
as document-node()?
{
    doc($uri)
};

(:~
 : XQuery does not support options for controlling the parsing of XML.
 : This function allows the use of proprietary fetch:xml to specify some
 : options to the XML parser.
 :
 : Also there's a difference with fn:doc in that each call fetches a
 : new document and it is discarded after the query ends.
 :
 : For options see: http://docs.basex.org/wiki/Options#Parsing
 :)
declare function o:read-xml($uri as xs:string, $options as map(xs:string, item()))
as document-node()?
{
    fetch:xml($uri, u:select-keys($options, $o:xml-options))
};

declare variable $o:xml-options :=
    ('chop', 'stripns', 'intparse', 'dtd', 'xinclude', 'catfile', 'skipcorrupt');

(:~
 : Read and parse HTML with the Tagsoup parser (although this could be changed).
 : If Tagsoup is not available it will fallback to parsing well-formed XML.
 :
 : For options see: http://docs.basex.org/wiki/Parsers#TagSoup_Options
 :)
declare function  o:read-html($uri as xs:string)
as document-node()?
{
    o:read-html($uri, map { 'lines': false() })
};

declare function o:read-html($uri as xs:string, $options as map(xs:string, item()))
as document-node()?
{
    o:parse-html(o:read-text($uri, map:merge(($options, map { 'lines': false() }))), $options)
};

(:~
 : Note that binary or strings can be passed to html:parse, in which case encoding
 : can be used to override automatic detection.
 : We can also just pass in a seq of strings.
 :)
declare function o:parse-html($text as xs:string*)
as document-node()?
{
    html:parse(string-join($text, ''))
};

declare function o:parse-html($text as xs:string*, $options as map(xs:string, item()))
as document-node()?
{
    html:parse(string-join($text, ''), u:select-keys($options, $o:html-options))
};

(:~
 : TagSoup options not supported by BaseX:
 : files, method, version, standalone, pyx, pyxin, output-encoding, reuse, help
 : Note that encoding is not passed as text read with $o:read-text or provided
 : already is in Unicode.
 :)
declare %private variable $o:html-options :=
    ('html', 'omit-xml-declaration', 'doctype-system', 'doctype-public', 'nons',
     'nobogons', 'nodefaults', 'nocolons', 'norestart', 'ignorable', 'empty-bogons', 'any',
     'norootbogons', 'lexical', 'nocdata');

(:~
 : Options:
 :
 : - lines: true() or false()
 : - encoding
 :)
declare function o:read-text($uri as xs:string)
as xs:string*
{
    o:read-text($uri, map { })
};

declare function o:read-text($uri as xs:string, $options as map(xs:string, item()))
as xs:string*
{
    let $parse-into-lines := ($options?lines, true())[1]
    let $encoding := $options?encoding
    return
        if ($parse-into-lines) then
            if ($encoding) then
                unparsed-text-lines($uri, $encoding)
            else
                unparsed-text-lines($uri)
        else
            if ($encoding) then
                unparsed-text($uri, $encoding)
            else unparsed-text($uri)
};

declare function o:read-json($uri as xs:string)
as item()?
{
    o:read-json($uri, map {})
};

declare function o:read-json($uri as xs:string, $options as map(xs:string, item()))
as item()?
{
    json-doc($uri, u:select-keys($options, $o:xml-options))
};

(:~
 : Options:
 :
 : - liberal: true() or false() [default, RFC7159 parsing]
 : - unescape: true() or false() [default true()]
 : - duplicates: reject, use-first, use-last [default use-last]
 :
 : See: http://www.w3.org/TR/xpath-functions-31/#func-parse-json
 :)
declare function o:parse-json($text as xs:string*)
as item()?
{
    parse-json(string-join($text,''))
};

declare function o:parse-json($text as xs:string*, $options as map(xs:string, item()))
as item()?
{
    parse-json(string-join($text,''), $options?($o:json-options))
};

declare %private variable $o:json-options :=
    ('liberal', 'unescape', 'duplicates');

(:~
 : Options:
 :
 : - encoding (for text decoding)
 : - separator: comma, semicolon, tab, space or any single character (default comma)
 : - lax: yes, no (yes) lax approach to parsing qnames to json names
 : - quotes: yes, no (yes)
 : - backslashes: yes, no (no)
 :
 : TODO: check which options are only meant for serialization.
 :)
declare function o:read-csv($uri as xs:string)
as array(*)*
{
    o:read-csv($uri, map {})
};

declare function o:read-csv($uri as xs:string, $options as map(xs:string, item()))
as array(*)*
{
    o:parse-csv(
        o:read-text(
            $uri,
            map:merge(($options, map { 'lines': false() }))
        ),
        $options
    )
};

declare function o:parse-csv($text as xs:string*)
as array(*)*
{
    o:parse-csv($text, map {})
};

declare function o:parse-csv($text as xs:string*, $options as map(xs:string, item()))
as array(*)*
{
    o:csv-normal-form(
        csv:parse(
            string-join($text,'
'),
            map:merge((u:select-keys($options, $o:csv-options), map { 'format': 'map' }))
        )
    )
};

(: ignore format option (only supported normalized form), header is dealt with in o:csv-object :)
declare %private variable $o:csv-options :=
    ('separator', 'lax', 'quotes', 'backslashes');

(:~
 : BaseX csv:parse returns a map with keys, this turns it into
 : a sequence of arrays (each array corresponds with a row)
 :)
declare %private function o:csv-normal-form($csv)
{
    map:keys($csv) ! array { $csv(.) }
};

(: Origami templating :)

(:~
 : Convert XML nodes to a μ-document.
 :)

(: TODO: whitespace handling :)
declare function o:doc($nodes as item()*)
as item()*
{
    o:xform()($nodes)
};

(:~
 : Convert XML nodes to a μ-document and attaching transformation functions
 : to some of the element nodes.
 :)
declare function o:doc($nodes as item()*, $rules as item()*)
as item()*
{
    o:xform($rules, map {})($nodes)
};

declare function o:doc($nodes as item()*, $rules as item()*, $options as map(*))
as item()*
{
    o:xform($rules, $options)($nodes)
};

(: TODO: also attach handlers to attributes and remove attributes by not copying them :)
(: ISSUE: what if we want to remove all inline tags in, say, a table cell? :)
(: ISSUE: attaching handlers to matched nodes (these aren't always element nodes - add test case for this :)

declare function o:xform()
{
    o:xform(map {}, map {})
};

declare function o:xform($rules as item()*)
as item()*
{
    o:xform($rules, map {})
};

(: TODO: attribute handlers :)
declare function o:xform($rules as item()*, $options as map(*))
as item()*
{
    typeswitch ($rules)
    case array(*)* return
        let $rules := o:compile-rules($rules)
        let $extractor := o:compile-stylesheet($rules)
        return o:merge-handlers($extractor, $rules, $options)
    case map(*) return
        function($nodes) { $nodes ! o:doc-node(., $rules) }
    default return
        function($nodes) { $nodes ! o:doc-node(., map {}) }
};

declare %private function o:doc-node($item as item())
{
    o:doc-node($item, map {})
};

declare %private function o:doc-node($item as item(), $rules as map(*))
as item()*
{
    typeswitch($item)
    case document-node() return
        o:doc-node($item/*, $rules)
    case processing-instruction() return
        ()
    case comment() return
        ()
    case element() return
        if  (name($item) = 'o:seq') then
            $item/node() ! o:doc-node(., $rules)
        else
            array {
                name($item),
                if ($item/@* or map:contains($rules, name($item))) then
                    map:merge((
                        for $a in $item/@* except $item/@o:path
                        return map:entry(name($a), data($a)),
                        let $path :=
                            if ($item[@o:path])
                            then string($item/@o:path)
                            else name($item)
                        return
                            if (map:contains($rules, $path))
                            then map:entry($o:handler-att, $rules($path))
                            else ()
                    ))
                else
                    (),
                $item/node() ! o:doc-node(., $rules)
            }
    case array(*) return
        let $tag := o:tag($item)
        let $atts := o:attributes($item)
        let $content := o:content($item)
        return
            array { $tag, $atts, $content ! o:doc-node(., $rules) }
    case text() return
        string($item)
    default return
        $item
};

(: "Serializing" :)
(:~
 : Converts μ-nodes to XML nodes with the default name resolver.
 :)
declare function o:xml($mu as item()*)
as node()*
{
    o:to-xml($mu, o:qname-resolver(o:ns()), map {})
};

(:~
 : Converts μ-nodes to XML nodes using a map of options. Currently it will
 : only use the options 'ns' whose value must be a namespace map and 'default-ns'
 : whose value must be a valide namespace URI.
 :)
declare function o:xml($mu as item()*, $options as map(*))
as node()*
{
    o:to-xml(
        $mu,
        o:qname-resolver(o:ns($options?ns), $options?default-ns),
        $options
    )
};

(: TODO: namespace handling, especially to-attributes :)
(: TODO: default namespaces was set to XSLT o:qname-resolver($ns-map, $ns-map?xsl)
         but this isn't the right approach :)
declare %private function o:to-xml($mu as item()*, $name-resolver as function(xs:string) as xs:QName, $options as map(*))
as node()*
{
    $mu ! (
        typeswitch (.)
        case array(*) return
            o:to-element(., $name-resolver, $options)
        case map(*) return
            o:to-attributes(., $name-resolver)
        case function(*) return
            ()
        case empty-sequence() return
            ()
        case node() return
            .
        default return
            text { . }
    )
};

(: TODO: need more common map manipulation functions :)
(: TODO: change ns handling to using a map to construct them at the top (sane namespaces) :)
(: TODO: in mu we should not get xmlns attributes so change o:doc to take them off :)
declare %private function o:to-element($element as array(*), $name-resolver as function(*), $options)
as item()*
{
    let $tag := o:tag($element)
    let $atts := o:attrs($element)
    let $content := o:content($element)
    where $tag
    return
        element { $name-resolver($tag) } {
            (: TODO: this shouldn't be in here but was here for compile template, move it there :)
            (: namespace μ { 'http://xokomola.com/xquery/origami/mu' }, :)
            namespace o { 'http://xokomola.com/xquery/origami' },
            if ($options?ns instance of map(*)) then
                for $prefix in map:keys($options?ns)
                let $uri := $options?ns($prefix)
                where $prefix != '' and $uri != ''
                return
                    namespace { $prefix } { $uri }
            else
                (),
            o:to-attributes($atts, $name-resolver),
            fold-left($content, (),
                function($n, $i) {
                    ($n, o:to-xml($i, $name-resolver, $options))
                }
            )
        }
};

(: TODO: we need an option for attribute serialization :)
(: NOTE: another reason why we should avoid names with :, conversion to json is easier? Maybe also makes JSON-LD easier :)
declare %private function o:to-attributes($atts as map(*), $name-resolver as function(*))
as attribute()*
{
    map:for-each($atts,
        function($k,$v) {
            if ($k = $o:internal-att
                or namespace-uri-from-QName($name-resolver($k))
                = 'http://xokomola.com/xquery/origami') then
                ()
            else
                (: should not add default ns to attributes if name has no prefix :)
                attribute { if (contains($k,':')) then $name-resolver($k) else $k } {
                    data(
                        typeswitch ($v)
                        case array(*) return
                            $v
                        case map(*) return
                            $v
                        case function(*) return
                            ()
                        default return
                            $v
                    )
                }
        }
    )
};

(:~
 : Create a template using a node sequence and a sequence of
 : template rules. If there are template rules then the
 : template accepts a single map item as context data. If there
 : are no template rules the template will not accept context
 : data.
 :)

(:~
 : Create a template using a node sequence, a sequence of template
 : rules and a context function. The context function determines the
 : signature of the arguments accepted by the template. The context
 : function takes the arguments and prepares the context map for the
 : use by the template rules.
 :)
(: TODO: can't we simplify on always having an on array arg function as context corresp. to apply :)

declare function o:stylesheet($rules as array(*)*)
{
    o:compile-stylesheet(o:compile-rules($rules), map {})
};

declare function o:stylesheet($rules as array(*)*, $options as map(*))
{
    o:compile-stylesheet(o:compile-rules($rules), $options)
};

declare function o:rules($rules as array(*)*)
{
    o:compile-rules($rules)
};

declare %private function o:merge-handlers($extractor, $rules, $options)
{
    function($nodes) {
        o:prewalk(
            o:xslt($extractor, $options)($nodes),
            o:merge-handlers-on-node($rules))
    }
};

(: TODO: clean up o:id mess :)
declare %private function o:merge-handlers-on-node($rules)
{
    function($element as array(*)) {
        let $tag := o:tag($element)
        let $attrs := o:attrs($element)
        let $content := o:content($element)
        let $rule :=
            if (map:contains($attrs,'o:id')) then
                $rules(QName('http://xokomola.com/xquery/origami', $attrs('o:id')))
            else
                map {}
        let $merged-attributes :=
            map:merge((
                map:for-each($attrs,
                    function($k,$v) { if ($k = 'o:id') then () else map:entry($k,$v) }
                ),
                if (map:contains($rule,'handler')) then
                    map:entry($o:handler-att, $rule?handler)
                else
                    ()
            ))
        return
            array {
                $tag,
                if (map:size($merged-attributes) > 0) then
                    $merged-attributes
                else
                    (),
                $content
            }
    }
};

(: TODO: ['p', fn1#2, fn2#2, fn3#2] compose a node transformer/pipeline :)
(: TODO: also should work with 1 item arrays :)

(:~
 : Prepare a map that is used in a transformer to attach the correct
 : handler to the correct mu-node. Also has prepares the tail of the rule
 : to compose pipelines (?)
 :)
declare %private function o:compile-rules($rules as array(*)*)
as map(*)
{
    map:merge($rules ! o:compile-rule(., ()))
};

(:~
 : Compiles a rule structure into a series of template descriptions which
 : can be compiled into an XSLT stylesheet using o:compile-stylesheet.
 :)
declare %private function o:compile-rule($rule as array(*), $context as xs:string*)
as item()*
{
    let $head := array:head($rule)
    let $hash := o:mode(($context, $head))
    let $mode := o:mode($context)
    let $tail := array:tail($rule)
    let $handler :=
        if (array:size($tail) > 0) then
            (: TODO: clean this up :)
            typeswitch(array:head($tail))
            case map(*) return
                ()
            case array(*) return
                ()
            case function(*) return
                array:head($tail)
            default return
                ()
        else
            ()
    let $op :=
        if (array:size($tail) = 0
            or (array:size($tail) > 0
                and not(array:head($tail) instance of empty-sequence()))) then
            'copy'
        else
            'remove'
    let $rules :=
        if (array:size($tail) > 0
            and array:head($tail) instance of empty-sequence()) then
            array:tail($tail)
        else
            $tail
    return (
        map:entry($hash,
            map:merge((
                map:entry('xpath', $head),
                map:entry('context', $context),
                map:entry('mode', $mode),
                map:entry('op', $op),
                if (exists($handler)) then
                    map:entry('handler', $handler)
                else
                    ()
            ))
        ),
        for $rule in $rules?*
        return
            typeswitch ($rule)
            case array(*) return
                o:compile-rule($rule, ($context,$head))
            case map(*) return
                ()
            case function(*) return
                () (: for now :)
            default return
                ()
    )
};

(:~
 : private
 : Generate a QName string unique for the context and suitable for use in XSLT mode attribute.
 :)

(: NOTE: this doesn't protect us from clashes, it would just overwrite a previous rule entry :)
(: TODO: probably better to use normal string instead of QName :)
declare %private function o:mode($paths as xs:string*)
as xs:QName {
    QName(
        'http://xokomola.com/xquery/origami',
        concat('_', xs:hexBinary(hash:md5(string-join($paths,' * '))))
    )
};

declare %private function o:compile-stylesheet($rules as map(*))
as element(*)
{
    o:compile-stylesheet($rules, map {})
};

declare %private function o:compile-stylesheet($rules as map(*), $options as map(*))
as element(*)
{
    o:xml(
        ['stylesheet',
            map:merge((
                map:entry('version', '1.0')
            )),
            ['output', map { 'method': 'xml' }],
            ['template', map { 'match': '/' },
                ['o:seq',
                    map:for-each($rules,
                        function($hash, $rule) {
                            if (empty($rule?context)) then
                                ['apply-templates']
                            else
                                ()
                        }
                    )
                ]
            ],
            ['template', map { 'match': 'text()' }],
            map:for-each($rules,
                function($hash, $rule) {
                    let $xpath := translate($rule?xpath, ""","'")
                    let $context := $rule?context
                    let $mode := $rule?mode
                    let $op := $rule?op
                    return
                        ['template',
                            map:merge((
                                map:entry('match', $xpath),
                                if (empty($context)) then
                                    ()
                                else
                                    map:entry('mode', $mode)
                            )),
                            if ($op = 'copy') then
                                ['copy',
                                    ['attribute', map { 'name': 'o:id' }, $hash ],
                                    (: for debugging :)
                                    ['attribute', map { 'name': 'o:path' }, string-join(($context,$xpath),' * ') ],
                                    ['apply-templates', map { 'select': 'node()|@*', 'mode': $hash }]
                                ]
                            else
                                ['apply-templates', map { 'select': 'node()|@*', 'mode': $hash }]
                        ]
                }
            ),
            map:for-each($rules,
                function($mode, $rule) {
                    if ($rule?op = 'remove') then
                        (
                            ['template', map { 'match': 'text()|processing-instruction()|comment()', 'mode': $mode }],
                            ['template', map { 'priority': -10, 'match': '@*|*', 'mode': $mode },
                                ['apply-templates', map { 'select': '*|@*|text()', 'mode': $mode }]
                            ]
                        )
                    else
                        (
                            ['template', map { 'match': 'processing-instruction()|comment()', 'mode': $mode }],
                            ['template', map { 'priority': -10, 'match': '@*|*', 'mode': $mode },
                                ['copy',
                                    ['apply-templates', map { 'select': '*|@*|text()', 'mode': $mode }]
                                ]
                            ]
                        )
                }
            )
        ],
        map { 'ns': $options?ns, 'default-ns': 'http://www.w3.org/1999/XSL/Transform' }
    )
};

declare %private function o:identity-transform()
as array(*)+
{
    ['template', map { 'priority': -10, 'match': '@*|*' },
        ['copy',
            ['apply-templates', map { 'select': '*|@*|text()' }]
        ]
    ],
    ['template', map { 'match': 'processing-instruction()|comment()' }]
};

(:~
 : Converts μ-nodes to JSON with the default name resolver.
 :)
declare function o:json($mu as item()*)
as xs:string
{
    o:json($mu, function($name) { $name })
};

(:~
 : Converts μ-nodes to JSON using a name-resolver.
 :)
(: TODO: probably should be symmetrical with o:xml (options) :)
declare function o:json($mu as item()*, $name-resolver as function(*))
as xs:string
{
    serialize(
        o:to-json(if (count($mu) > 1) then array { $mu } else $mu, $name-resolver),
        map { 'method': 'json' }
    )
};

(: TODO: prefix attribute names with @?, plus general improvement :)
declare %private function o:to-json($mu as item()*, $name-resolver as function(*))
as item()*
{
    $mu ! (
        typeswitch (.)
        case array(*) return
            let $tag := o:tag(.)
            let $atts := o:attributes(.)
            let $children := o:content(.)
            return
                map:entry(
                    $tag,
                    o:to-json(($atts, $children), $name-resolver)
                )
        case map(*) return
            map:merge(
                map:for-each(.,
                    function($a,$b) {
                        map:entry(
                            concat(o:handler-att, $a),
                            o:to-json($b, $name-resolver)
                        )
                    }
                )
            )
        case function(*) return
            ()
        (: FIXME: I think this should be using to-json as well :)
        case node() return
            o:doc(.)
        default return
            .
    )
};

(: Namespace support :)
(:~
 : Returns a name resolver function with the HTML namespace as default.
 :)
declare function o:html-resolver()
as function(xs:string) as xs:QName
{
    o:qname(?, o:ns(), 'http://www.w3.org/1999/xhtml')
};

(:~
 : Returns a name resolver function from the default namespace map (nsmap.xml).
 :)
declare function o:qname-resolver()
as function(xs:string) as xs:QName
{
    o:qname(?, $o:ns, ())
};

(:~
 : Returns a name resolver function from the namespace map passed as it's argument.
 :)
declare function o:qname-resolver($ns-map as map(*))
as function(xs:string) as xs:QName
{
    o:qname(?, $ns-map, ())
};

(:~
 : Returns a name resolver function from the namespace map passed as it's first
 : argument and using the second argument as the default namespace.
 :)
declare function o:qname-resolver($ns-map as map(*), $default-ns as xs:string?)
as function(xs:string) as xs:QName
{
    o:qname(?, $ns-map, $default-ns)
};

(:~
 : Get a namespace map from XML nodes. Note that this assumes somewhat sane[1]
 : namespace usage. The resulting map will contain a prefix/URI entry for each
 : used prefix but it will not re-binding a prefix to a different URI at
 : descendant nodes. Unused prefixes are dropped.
 : The result can be used when serializing back to XML but results may be not
 : what you expect if you pass insane XML fragments.
 :
 : [1] http://lists.xml.org/archives/xml-dev/200204/msg00170.html
 :)
declare function o:ns-map-from-nodes($nodes as node()*)
as map(*)
{
    map:merge((
        for $node in reverse($nodes/descendant-or-self::*)
        let $qname := node-name($node)
        return (
            for $att in $node/@*
            let $qname := node-name($att)
            return
                map:entry((prefix-from-QName($qname),'')[1], namespace-uri-from-QName($qname)),
            map:entry((prefix-from-QName($qname),'')[1], namespace-uri-from-QName($qname))
        )
    ))
};

(:~
 : Get a namespace map from XML nodes. Will throw an exception with insane
 : namespace usage. Unused prefixes will not be dropped. However, unused prefixes
 : cannot be added to an XML fragment due to a limitation in current XPath [1].
 : In Origami XML may be built from dynamic parts which means that when a prefix
 : isn't used in the $nodes it may still be used when serializing to XML.
 :
 : [1] http://thread.gmane.org/gmane.text.xml.xsl.general.mulberrytech/54436
 :)
declare function o:sane-ns-map-from-nodes($nodes as node()*)
{
    'TODO'
};

(:~
 : Returns a QName in "no namespace".
 : Throws a dynamic error FOCA0002 with a prefixed name.
 :)
declare function o:qname($name as xs:string)
as xs:QName
{
    QName((), $name)
};

(:~
 : Returns a QName from a string taking the namespace URI from the
 : namespace map passed as it's second argument.
 : Throws a dynamic error FOCA0002 with a name which is not in correct lexical form.
 : Returns a QName in a made-up namespace URI if the prefix is not defined in the
 : namespace map.
 :)
declare function o:qname($name as xs:string, $ns-map as map(*))
as xs:QName
{
    o:qname($name, $ns-map, ())
};

(:~
 : Same as o:qname#2 but uses a third argument to specify a default namespace URI.
 :)
declare function o:qname($name as xs:string, $ns-map as map(*), $default-ns as xs:string?)
as xs:QName
{
    if (contains($name, ':'))
    then
        let $prefix := substring-before($name,':')
        let $local := substring-after($name, ':')
        let $ns := ($ns-map($prefix), concat('ns:prefix:', $prefix))[1]
        return
            if ($ns = $default-ns) then
                QName($ns, $local)
            else
                QName($ns, concat($prefix, ':', $local))
    else
        if ($default-ns) then
            QName($default-ns, $name)
        else
            QName((), $name)
};

(:~
 : Builds a namespace map from the default namespace map provided in the
 : XML file nsmap.xml.
 :)
declare function o:ns()
as map(*)
{
    o:ns(())
};

(:~
 : Builds a namespace map from the default namespace map provided in the
 : XML file nsmap.xml and adding extra namespace mappings from a map provided
 : as the argument. The latter mappings will override existing mappings in the
 : default namespace map.
 :)
declare function o:ns($ns-map as map(*)?)
as map(*)
{
    map:merge((
        ($ns-map, map {})[1],
        for $ns in doc(concat(file:base-dir(),'/nsmap.xml'))/nsmap/*
        return
            map:entry(string($ns/@prefix), string($ns/@uri))
    ))
};

(: μ-node information :)
declare function o:head($element as array(*)?)
as item()*
{
    if (exists($element)) then
        array:head($element)
    else
        ()
};

declare function o:tail($element as array(*)?)
as item()*
{
    tail($element?*)
};

declare function o:tag($element as array(*)?)
as xs:string?
{
    if (exists($element)) then
        array:head($element)
    else
        ()
};

declare function o:content($element as array(*)?)
as item()*
{
    if (exists($element) and array:size($element) > 0) then
        let $c := array:tail($element)
        return
            if (array:size($c) > 0 and array:head($c) instance of map(*)) then
                array:tail($c)?*
            else
                $c?*
    else
        ()
};

declare function o:attributes($element as array(*)?)
as map(*)?
{
    if (exists($element)
        and array:size($element) > 1
        and $element?2 instance of map(*)) then
        $element?2
    else
        ()
};

(:~
 : Always returns a map even if element has no attributes.
 :
 : Note that for access to attributes in handlers using the lookup operator (?)
 : you can use both o:attrs($e)?foo as well as o:attributes($e)?foo because
 : ()?foo will work just like map{}?foo.
 :)
declare function o:attrs($element as array(*)?)
as map(*)
{
    (o:attributes($element), map {})[1]
};

(:~
 : Returns the size of contents (child nodes not attributes).
 :)
declare function o:size($element as array(*)?)
as item()*
{
    count(o:content($element))
};

declare function o:apply($nodes as item()*)
{
    o:apply($nodes, (), [])
};

declare function o:apply($nodes as item()*, $ctx as array(*))
as item()*
{
    o:apply($nodes, (), $ctx)
};

declare function o:apply($nodes as item()*, $current as array(*)?, $ctx as array(*))
as item()*
{
    (: TODO: top-level apply doesn't have a current element in context :)
    $nodes ! (
        switch (o:is-element-or-handler(.))
        case $o:is-element return
            o:apply-element(., $ctx)
        case $o:is-handler return
            o:apply-handler(., $current, $ctx)
        default return
            .
    )
};

declare function o:apply-element($element as array(*), $ctx as array(*))
{
    let $tag := o:tag($element)
    let $handler := o:handler($element)
    let $ctx := o:context($element, $ctx)
    let $atts := o:apply-attributes($element, $ctx)
    let $content := o:content($element)
    return
        if (exists($handler)) then
            o:apply-handler(
                $handler,
                array { $tag, $atts, $content },
                $ctx
            )
        else
            array { $tag, $atts,
                o:apply($content, $element, $ctx)
            }
};

declare function o:apply-attributes($element as array(*), $ctx as item()*)
{
    let $atts :=
        map:merge((
            map:for-each(
                o:attrs($element),
                function($att-name, $att-value) {
                    if ($att-name = $o:internal-att) then
                        ()
                    else
                        map:entry(
                            $att-name,
                            switch (o:is-element-or-handler($att-value))
                            case $o:is-handler return
                                o:apply-handler($att-value, $element, $ctx)
                            default return
                                $att-value
                        )
                }
            )
        ))
    where map:size($atts) > 0
    return $atts
};

(: returns true if this is an element, false if this is a handler or nil it is neither :)
declare function o:is-element-or-handler($node as item()*)
as xs:boolean? {
    typeswitch ($node)
    case array(*)
    return
        if (array:size($node) = 0) then
            ()
        else
            typeswitch (array:head($node))
            case empty-sequence() return
                ()
            case xs:string return
                $o:is-element
            case array(*) return
                ()
            case map(*) return
                ()
            case function(*) return
                $o:is-handler
            default return
                ()
    case map(*) return
        ()
    case function(*) return
        $o:is-handler
    default return
        ()
};

(: NOTE: $handler is already identified as a handler :)
(: TODO: apply-handler should be private :)

declare function o:apply-handler($handler as item(), $current as array(*)?, $ctx as array(*))
as item()*
{
    if ($handler instance of array(*)) then
        apply(array:head($handler), array:join(([$current], array:tail($handler), $ctx)))
    else
        apply($handler, array:join(([$current], $ctx)))
};

(: μ-node transformers :)

declare function o:identity($x) { $x };

declare function o:map($n as array(*)?, $fn as function(*))
{
    $fn($n),
    o:content($n) ! o:map(., $fn)
};

declare function o:filter($n as array(*)?, $fn as function(*))
{
    if ($fn($n)) then $n else (),
    o:content($n) ! o:filter(., $fn)
};

(:~
 : Returns a sequence even if the argument is an array.
 : TODO: should this also flatten maps into a seq?
 :)
declare function o:seq($x as item()*)
{
    if ($x instance of array(*)) then
        $x?*
    else if ($x instance of map(*)) then
        map:for-each($x, function($k,$v) { ($k,$v) })
    else
        $x
};

(:~
 : Generic walker function that traverses the μ-node (depth-first).
 :)
declare function o:postwalk($form as item()*, $fn as function(*))
{
    $form ! (
        typeswitch (.)
        case array(*) return
            $fn(array {
                for $item in $form?*
                return o:postwalk($item, $fn)
            })
        default return
            $form
    )
};

(:~
 : Generic walker function that traverses the μ-node (breadth-first).
 :)
declare function o:prewalk($form as item()*, $fn as function(*))
{
    $form ! (
        let $walked := $fn(.)
        return
            typeswitch ($walked)
            case array(*) return
                array {
                    for $item in $walked?*
                    return
                        if ($item instance of array(*)) then
                            o:prewalk($item, $fn)
                        else
                            $item
                }
            default return
                $walked
    )
};

declare function o:has-handler($element as array(*))
as xs:boolean
{
    map:contains(o:attrs($element), $o:handler-att)
};

declare function o:handler($element as array(*))
{
    o:attrs($element)($o:handler-att)
};

declare function o:set-handler($handler as array(*)?)
as function(*)
{
    function($element as array(*)) {
        array {
            o:tag($element),
            map:merge((o:attrs($element), map { $o:handler-att: $handler })),
            o:content($element)
        }
    }
};

declare function o:context($element as array(*)?)
{
    o:context($element, [])
};

(:~
 : Make a new context. Replacing head of $ctx with $element.
 :)
declare function o:context($element as array(*)?, $ctx as array(*))
{
    let $arg-handler := o:attrs($element)($o:data-att)
    return
        typeswitch ($arg-handler)
        case empty-sequence() return
            $ctx
        case array(*) return
            $arg-handler
        case map(*) return
            [$arg-handler]
        case function(*) return
            [apply($arg-handler, array:join(([$element], $ctx)))]
        default return
            [$arg-handler]
};

declare function o:set-data($element as array(*), $data as item()*)
as function(*)
{
    o:set-data($data)($element)
};

declare function o:set-data($data as item()*)
as function(*)
{
    function($element as array(*)) {
        array {
            o:tag($element),
            map:merge((o:attrs($element), map { $o:data-att: $data })),
            o:content($element)
        }
    }
};

(:~
 : Replace the child nodes of `$element` with `$content`.
 :)
declare function o:set-handler($element as array(*), $handler as array(*)?)
as array(*)
{
    o:set-handler($handler)($element)
};

(:~
 : Create a node transformer that replaces the child nodes of an
 : element with `$content`.
 :)
declare function o:insert($content as item()*)
as function(*)
{
    function($mu as array(*)) {
        array { o:tag($mu), o:attributes($mu), $content }
    }
};

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

declare function o:replace()
as function(*) {
    function($context as item()*) {
        ()
    }
};

declare function o:replace($content as item()*)
as function(*) {
    function($context as item()*) {
        $content
    }
};

declare function o:replace($context as item()*, $content as item()*)
as item()*
{
    o:replace($content)($context)
};

declare function o:wrap($mu as array(*)?)
as function(*)
{
    if (exists($mu)) then
        function($content as item()*) {
            array { o:tag($mu), o:attributes($mu), $content }
        }
    else
        function($content as item()*) {
            $content
        }
};

declare function o:wrap($content as item()*, $mu as array(*)?)
as item()*
{
    o:wrap($mu)($content)
};

(:~
 : Create a node transformer that removes (unwraps) the
 : outer element of all nodes that are elements. Other nodes
 : are passed through unmodified.
 :)
declare function o:unwrap()
as function(item()*) as item()*
{
    function($content as item()*) {
        $content ! (
            typeswitch(.)
            case array(*) return
                o:content(.)
            default return
                .
        )
    }
};

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

(:~
 : Copy nodes without any transformation.
 :)
declare function o:copy()
as function(item()*) as item()*
{
    function($content as item()*) {
        $content
    }
};

declare function o:copy($content as item()*)
as item()*
{
    o:copy()($content)
};

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

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

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

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

(:~
 : Create a node transformer that appends `$append` nodes
 : to the child nodes of each element of `$nodes`.
 :)
declare function o:insert-after($append as item()*)
as function(item()*) as item()*
{
   function($mu as array(*)) {
        array { o:tag($mu), o:attributes($mu), o:content($mu), $append }
    }
};

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

(:~
 : Create a node transformer that prepends `$prepend` nodes
 : to the child nodes of each element of `$nodes`.
 :)
declare function o:insert-before($prepend as item()*)
as function(item()*) as item()*
{
   function($mu as array(*)) {
        array { o:tag($mu), o:attributes($mu), $prepend, o:content($mu) }
    }
};

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

(:~
 : Create a node transformer that returns a text node with
 : the space normalized string value of a node.
 :)
declare function o:text()
as function(item()*) as item()*
{
    function($nodes as item()*) as xs:string* {
        $nodes ! (
            typeswitch (.)
            case map(*) return
                ()
            case array(*) return
                o:text(o:content(.))
            case function(*) return
                ()
            default return
                string(.)
        )
    }
};

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

declare function o:ntext()
as function(item()*) as item()*
{
    function($nodes as item()*) as xs:string* {
        normalize-space(string-join(
            $nodes ! (
                typeswitch (.)
                case map(*) return
                    ()
                case array(*) return
                    o:ntext(o:content(.))
                case function(*) return
                    ()
                default return
                    string(.)
            )
        ,''))
    }
};

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

(:~
 : Create a node transformer that sets attributes using a map
 : on each element in the nodes passed.
 :)
declare function o:set-attr($attributes as map(*))
as function(item()*) as item()*
{
    function($node as array(*)) {
        array {
            o:tag($node),
            map:merge((o:attributes($node), $attributes)),
            o:content($node)
        }
    }
};

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

(:~
 : Create a node transformer that remove attributes.
 :
 : If a name cannot be used as an attribute name (xs:QName) then
 : it will be silently ignored.
 :
 : TODO: better testing and clean up code.
 :)
declare function o:remove-attr($remove-atts as xs:string*)
as function(item()*) as item()*
{
    function($element as array(*)) {
        let $atts :=
            map:merge((
                map:for-each(o:attrs($element),
                    function($k,$v) {
                        if ($k = $remove-atts) then
                            ()
                        else
                            map:entry($k,$v)
                    }
                )
            ))
        return
            array {
                o:tag($element),
                if (map:size($atts) = 0) then
                    ()
                else
                    $atts,
                o:content($element)
            }
    }
};

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

(:~
 : Create a node transformer that adds one or more class names to
 : each element in the nodes passed.
 :)
declare function o:add-class($names as xs:string*)
as function(item()*) as item()*
{
    function($element as array(*)) {
        let $atts := o:attrs($element)
        return
            array {
                o:tag($element),
                map:merge((
                    $atts,
                    map:entry('class',
                        string-join(
                            distinct-values(
                                tokenize(
                                    string-join(($atts?class,$names),' '), '\s+')), ' ')
                    )
                )),
                o:content($element)
            }
    }
};

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

(:~
 : Create a node transformer that removes one or more `$names` from the
 : class attribute. If the class attribute is empty after removing names it will
 : be removed from the element.
 :)

declare function o:remove-class($names as xs:string*)
as function(item()*) as item()*
{
   function($element as array(*)) {
        let $atts := o:attrs($element)
        let $classes := tokenize($atts?class,'\s+')
        let $new-classes :=
            for $class in $classes
            where not($class = $names)
            return $class
        let $new-atts :=
            if (count($new-classes) = 0) then
                map:remove($atts,'class')
            else
                map:merge((
                    $atts,
                    map:entry('class', string-join($new-classes, ' '))
                ))
        return
            array {
                o:tag($element),
                if (map:size($new-atts) = 0) then
                    ()
                else
                    $new-atts,
                o:content($element)
            }
    }
};

(:~
 : 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 o:remove-class($element as array(*), $names as xs:string*)
as item()*
{
    o:remove-class($names)($element)
};

(:~
 : Create a node-transformer that renames element nodes, passing non-element
 : nodes and element child nodes through unmodified.
 :
 : Renaming can be done using a:
 :
 : - `xs:string`: renames all elements
 : - `map(*)`: looks up the element name in the map and uses the value as the
 :   new name
 :)
declare function o:rename($name as item())
as function(item()*) as item()*
{
    function($node as array(*)) {
        let $new-name :=
            if ($name instance of map(*)) then
                $name(o:tag($node))
            else
                $name
        return
            if ($new-name) then
                array {
                    $new-name,
                    o:attributes($node),
                    o:content($node)
                }
            else
                $node
    }
};

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

(:~
 : Returns a node transformer that transforms nodes using
 : an XSLT stylesheet.
 : TODO: maybe template and snippet should also use this function.
 :)

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

declare function o:xslt($stylesheet as item()*, $params as map(*))
as function(*)
{
    function($nodes as item()*) as item()* {
        if (exists($nodes) and exists($stylesheet)) then
            o:doc(
                for $node in $nodes
                return
                    xslt:transform(
                        o:xml($nodes),
                        $stylesheet,
                        $params
                    )
            )
        else
            ()
    }
};

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


fixed issue with bad merge of health_worker_update_credential

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

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

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

let $provs0 := if (exists($careServicesRequest/id/@entityID)) then	csd_bl:filter_by_primary_id(/CSD/providerDirectory/*,$careServicesRequest/id) else ()
let $provs1 := if (count($provs0) = 1) then $provs0 else ()
let $provs2 := if (exists($careServicesRequest/credential/codedType/@code) and exists($careServicesRequest/credential/codedType/@codingScheme) ) then $provs1  else ()
let $cred_new := $careServicesRequest/credential
let $code:= $cred_new/codedType/@code
let $codingScheme:= $cred_new/codedType/@codingScheme
let $creds0 := $provs2/credential/codedType[@code = $code and @codingScheme = $codingScheme]
return
  if ( count($provs2) = 1 and count($creds0) = 1)  (:Update only:)
    then
    let $cred_old := $creds0[1]/..
    let $provider:= $provs2[1]
    let $provs3 :=
      <provider entityID="{$provider/@entityID}">
	<credential>
	  <codedType code="{$code}" codingScheme="{$codingScheme}"/>
	</credential>
      </provider>

    return

      (
	csd_blu:bump_timestamp($provider),
	if (exists($cred_new/issuingAuthority)) then
	  (if (exists($cred_old/issuingAuthority)) then (delete node $cred_old/issuingAuthority) else (),
	  insert node $cred_new/issuingAuthority into $cred_old)
	else (),
	if (exists($cred_new/number)) then
	  (if (exists($cred_old/number)) then (delete node $cred_old/number) else (),
	  insert node $cred_new/number into $cred_old)
	else (),
	if (exists($cred_new/credentialIssueDate)) then
	  (if (exists($cred_old/credentialIssueDate)) then (delete node $cred_old/credentialIssueDate) else (),
	  insert node $cred_new/credentialIssueDate into $cred_old)
	else (),
	if (exists($cred_new/credentialRenewalDate)) then
	  (if (exists($cred_old/credentialRenewalDate)) then (delete node $cred_old/credentialRenewalDate) else (),
	  insert node $cred_new/credentialRenewalDate into $cred_old)
	else (),
	csd_blu:wrap_updating_providers($provs3)
       )
  else 	csd_blu:wrap_updating_providers(())

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

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

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

let $provs0 := if (exists($careServicesRequest/id/@entityID)) then	csd_bl:filter_by_primary_id(/CSD/providerDirectory/*,$careServicesRequest/id) else ()
let $provs1 := if (count($provs0) = 1) then $provs0 else ()
let $provs2 := if (exists($careServicesRequest/credential/codedType/@code) and exists($careServicesRequest/credential/codedType/@codingScheme) ) then $provs1  else ()
let $cred_new := $careServicesRequest/credential
let $code:= $cred_new/codedType/@code
let $codingScheme:= $cred_new/codedType/@codingScheme
let $creds0 := $provs2/credential/codedType[@code = $code and @codingScheme = $codingScheme]
return
  if ( count($provs2) = 1 and count($creds0) = 1)  (:Update only:)
    then
    let $cred_old := $creds0[1]/..
    let $provider:= $provs2[1]
    let $provs3 :=
      <provider entityID="{$provider/@entityID}">
	<credential>
	  <codedType code="{$code}" codingScheme="{$codingScheme}"/>
	</credential>
      </provider>

    return

      (
	csd_blu:bump_timestamp($provider),
	if (exists($cred_new/issuingAuthority)) then
	  (if (exists($cred_old/issuingAuthority)) then (delete node $cred_old/issuingAuthority) else (),
	  insert node $cred_new/issuingAuthority into $cred_old)
	else (),
	if (exists($cred_new/number)) then
	  (if (exists($cred_old/number)) then (delete node $cred_old/number) else (),
	  insert node $cred_new/number into $cred_old)
	else (),
	if (exists($cred_new/credentialIssueDate)) then
	  (if (exists($cred_old/credentialIssueDate)) then (delete node $cred_old/credentialIssueDate) else (),
	  insert node $cred_new/credentialIssueDate into $cred_old)
	else (),
	if (exists($cred_new/credentialRenewalDate)) then
	  (if (exists($cred_old/credentialRenewalDate)) then (delete node $cred_old/credentialRenewalDate) else (),
	  insert node $cred_new/credentialRenewalDate into $cred_old)
	else (),
	csd_blu:wrap_updating_providers($provs3)
       )
<<<<<<< HEAD:resources/stored_updating_query_defintions/health_worker_update_credential.xq
  else 	csd_blu:wrap_updating_providers((<bad cs="{$codingScheme}" c="{$code}"></bad>,count($provs2), count($creds0)))
=======
  else 	csd_blu:wrap_updating_providers(())
>>>>>>> 68032fd4f7430bb5d326107563409dfa5e1d7ca1:resources/stored_updating_query_definitions/health_worker_update_credential.xq


[ignore] reformatting controller

[ignore] reformatting controller

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

xquery version "1.0";

import module namespace request="http://exist-db.org/xquery/request";
import module namespace xdb = "http://exist-db.org/xquery/xmldb";

if ($exist:path = "/") then
    <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
		<redirect url="../examples.xml"/>
	</dispatch>

else if ($exist:resource = 'index.xml') then
    <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
		<redirect url="{$exist:context}/index.xml"/>
	</dispatch>

else if (ends-with($exist:path, '.xql/source')) then
    let $resource := substring-before($exist:path, '/source')
    return
        <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
    		<forward url="{$exist:controller}{$resource}?source"/>
    		<view>
    			<forward url="/xquery/source.xql">
                    <set-attribute name="resource" value="{$resource}"/>
                </forward>
    		</view>
    	</dispatch>

else if ($exist:resource = ('search.xql', 'functions.xql', 'svnlog.xql')) then
	<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
		<!-- query results are passed to XSLT servlet via request attribute -->
		<set-attribute name="xquery.attribute"
			value="model"/>
		<view>
			<forward servlet="XSLTServlet">
				<set-attribute name="xslt.input" value="model"/>
				<set-attribute name="xslt.stylesheet" value="{$exist:root}/stylesheets/db2xhtml.xsl"/>
				<set-attribute name="xslt.output.media-type" value="text/html"/>
				<set-attribute name="xslt.output.doctype-public" value="-//W3C//DTD XHTML 1.0 Transitional//EN"/>
				<set-attribute name="xslt.output.doctype-system" value="resources/xhtml1-transitional.dtd"/>
				<set-attribute name="xslt.root" value="{request:get-context-path()}{$exist:prefix}"/>
				<set-attribute name="xslt.base" value="{$exist:root}"/>
			</forward>
		</view>
		<cache-control cache="no"/>
	</dispatch>

else if ($exist:resource eq 'acronyms.xql') then
	<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
		<!-- query results are passed to XSLT servlet via request attribute -->
		<set-attribute name="xquery.attribute" value="model"/>
		<view>
			<forward servlet="XSLTServlet">
				<set-attribute name="xslt.input" value="model"/>
				<set-attribute name="xslt.stylesheet" value="stylesheets/acronyms.xsl"/>
			    <set-attribute name="xslt.base" value="{$exist:root}"/>
			</forward>
			<forward servlet="XSLTServlet">
				<set-attribute name="xslt.input" value=""/>
				<set-attribute name="xslt.stylesheet" value="{$exist:root}/stylesheets/db2xhtml.xsl"/>
				<set-attribute name="xslt.output.media-type" value="text/html"/>
				<set-attribute name="xslt.output.doctype-public"  value="-//W3C//DTD XHTML 1.0 Transitional//EN"/>
				<set-attribute name="xslt.output.doctype-system"  value="resources/xhtml1-transitional.dtd"/>
				<set-attribute name="xslt.root" value="{request:get-context-path()}{$exist:prefix}"/>
			</forward>
		</view>
	</dispatch>

else if ($exist:resource eq 'twitter.xql') then
    <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
       <forward url="twitter.xql"/>
        <view>
            <forward url="twitter-view.xql"/>
        </view>
    </dispatch>

else if (matches($exist:path, '(styles/syntax|scripts/syntax/|logo.jpg|default-style2.css|curvycorners.js)')) then
    let $newPath := replace($exist:path, '^.*((styles/|scripts/|logo).*)$', '/$1')
    return
        <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
    		<forward url="{$newPath}"/>
    		<cache-control cache="yes"/>
    	</dispatch>

else if (ends-with($exist:path, '/dump')) then
	let $newPath := substring-before($exist:path, '/dump')
	return
        <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			<forward url="{$exist:controller}{$newPath}"/>
			<view>
				<forward url="/xquery/dump.xql">
				   <set-attribute name="controller" value="{$exist:controller}"/>
				   <set-attribute name="path" value="{$exist:path}"/>
				   <set-attribute name="resource" value="{$exist:resource}"/>
			    </forward>
			</view>
		</dispatch>

else
    <ignore xmlns="http://exist.sourceforge.net/NS/exist">
        <cache-control cache="yes"/>
	</ignore>


Fixing Issue #1810: fixed single-step-ingest example (#1823)

xquery version "1.0-ml";

module namespace runIngestHarmonize = "http://marklogic.com/rest-api/resource/run-ingest-harmonize";

import module namespace consts = "http://marklogic.com/data-hub/consts"
  at "/data-hub/4/impl/consts.xqy";

import module namespace flow = "http://marklogic.com/data-hub/flow-lib"
  at "/data-hub/4/impl/flow-lib.xqy";

import module namespace config = "http://marklogic.com/data-hub/config"
  at "/com.marklogic.hub/config.xqy";

declare namespace hub = "http://marklogic.com/data-hub";
declare namespace rapi = "http://marklogic.com/rest-api";
declare namespace error = "http://marklogic.com/xdmp/error";

declare %rapi:transaction-mode("update") function runIngestHarmonize:put(
  $context as map:map,
  $params as map:map,
  $content as document-node()
  ) as document-node()
{
  let $job-id := map:get($params, "job-id")
  let $entity-name := map:get($params, 'entity-name')
  let $ingest-flow-name := map:get($params, 'ingest-flow-name')
  let $uri := map:get($params, 'uri')
  let $flow := flow:get-flow($entity-name, $ingest-flow-name, $consts:INPUT_FLOW)
  let $_ :=
    if ($flow) then ()
    else
      fn:error(xs:QName("MISSING_FLOW"), "The specified flow " || $entity-name || ":" || $ingest-flow-name || " is missing.")

  (: configure the options :)
  let $options as map:map := (
    map:get($params, "options") ! xdmp:unquote(.)/object-node(),
    map:map()
  )[1]
  let $_ := flow:set-default-options($options, $flow)

  let $mainFunction := flow:get-main($flow/hub:main)

  (: this can throw, but we want the REST API to know about the problems, so let it :)
  let $envelope := runIngestHarmonize:run-flow($job-id, $flow, $uri, $content, $options, $mainFunction)

  (: Insert the document into the STAGING database :)
  let $permissions := (xdmp:default-permissions(), xdmp:permission("rest-reader", "read"), xdmp:permission("rest-writer", "update"))
  let $collections := (xdmp:default-collections(), $entity-name, $ingest-flow-name, $consts:INPUT_FLOW)
  let $insertOptions :=
    <options xmlns="xdmp:document-insert">
      <permissions>{$permissions}</permissions>
      <collections>{
        for $collection in $collections
        return <collection>{$collection}</collection>
      }</collections>
    </options>
  let $_ := runIngestHarmonize:insert-document($uri, $envelope, $insertOptions)

  (: build all of the harmonization information :)
  let $harmonize-flow-name := map:get($params, 'harmonize-flow-name')
  let $flow := flow:get-flow($entity-name, $harmonize-flow-name, $consts:HARMONIZE_FLOW)
  let $_ :=
    if ($flow) then ()
    else
      fn:error(xs:QName("MISSING_FLOW"), "The specified flow " || $entity-name || ":" || $harmonize-flow-name || " is missing.")

  let $target-database :=
    if (fn:exists(map:get($params, "target-database"))) then
      xdmp:database(map:get($params, "target-database"))
    else
      xdmp:database($config:FINAL-DATABASE)
  (: add the target database to the harmonization options :)
  let $_ := (
    flow:set-default-options($options, $flow),
    map:put($options, "target-database", $target-database)
  )
  let $mainFunction := flow:get-main($flow/hub:main)
  let $errors := json:array()
  let $_ :=
    try {
      flow:run-flow($job-id, $flow, $uri, (), $options, $mainFunction)
    }
    catch($ex) {
      xdmp:log(("caught error in run-ingest-harmonize.xqy")),
      xdmp:log($ex/error:format-string),
      json:array-push($errors, $ex/error:format-string)
    }
  (: Run the writers :)
  let $_ :=
    try {
      flow:run-writers($uri)
    }
    catch($ex) {
      xdmp:log(("caught error in run-ingest-harmonize.xqy when running the writers")),
      xdmp:log($ex/error:format-string),
      json:array-push($errors, $ex/error:format-string)
    }
  return
    document {
      element response {
        element ingestion {
          $envelope
        },
        element harmonization {
          if (fn:empty(map:keys($errors))) then (
            element harmonizationSuccessful {fn:true()},
            element errorFound {fn:false()}
          )
          else (
            element harmonizationSuccessful {fn:false()},
            element errorFound {fn:true()},
            element errorMessage {$errors}
          )
        }
      }
    }
};

declare private function runIngestHarmonize:run-flow(
  $job-id as xs:string,
  $flow as element(hub:flow),
  $uri as xs:string,
  $content as item()?,
  $options as map:map,
  $mainFunction)
{
  (: The PUT command runs in update mode, so we need to eval in query mode :)
  xdmp:eval('
    import module namespace flow = "http://marklogic.com/data-hub/flow-lib"
      at "/data-hub/4/impl/flow-lib.xqy";

    declare variable $job-id external;
    declare variable $flow external;
    declare variable $uri external;
    declare variable $content external;
    declare variable $options external;
    declare variable $mainFunction external;

    flow:run-flow($job-id, $flow, $uri, $content, $options, $mainFunction)
  ',
  map:new((
    map:entry("job-id", $job-id),
    map:entry("flow", $flow),
    map:entry("uri", $uri),
    map:entry("content", $content),
    map:entry("options", $options),
    map:entry("mainFunction", $mainFunction)
  )))
};

declare private function runIngestHarmonize:insert-document(
  $uri as xs:string,
  $root as node(),
  $options as element()?) as empty-sequence()
{
  (: We need to evaluate the insert in a separate transaction so that it is visible to the harmonization flow :)
  xdmp:eval('
    declare variable $uri external;
    declare variable $root external;
    declare variable $options external;
    declare variable $collections external;

    xdmp:document-insert($uri, $root, $options)
  ',
  map:new((
    map:entry("uri", $uri),
    map:entry("root", $root),
    map:entry("options", $options)
  )))
};

xquery version "1.0-ml";

module namespace runIngestHarmonize = "http://marklogic.com/rest-api/resource/run-ingest-harmonize";

import module namespace consts = "http://marklogic.com/data-hub/consts"
  at "/data-hub/4/impl/consts.xqy";

import module namespace flow = "http://marklogic.com/data-hub/flow-lib"
  at "/data-hub/4/impl/flow-lib.xqy";

import module namespace config = "http://marklogic.com/data-hub/config"
  at "/com.marklogic.hub/config.xqy";

declare namespace hub = "http://marklogic.com/data-hub";
declare namespace rapi = "http://marklogic.com/rest-api";
declare namespace error = "http://marklogic.com/xdmp/error";

declare %rapi:transaction-mode("update") function runIngestHarmonize:put(
  $context as map:map,
  $params as map:map,
  $content as document-node()
  ) as document-node()
{
  let $job-id := map:get($params, "job-id")
  let $entity-name := map:get($params, 'entity-name')
  let $ingest-flow-name := map:get($params, 'ingest-flow-name')
  let $uri := map:get($params, 'uri')
  let $flow := flow:get-flow($entity-name, $ingest-flow-name, $consts:INPUT_FLOW)
  let $_ :=
    if ($flow) then ()
    else
      fn:error(xs:QName("MISSING_FLOW"), "The specified flow " || $entity-name || ":" || $ingest-flow-name || " is missing.")

  (: configure the options :)
  let $options as map:map := (
    map:get($params, "options") ! xdmp:unquote(.)/object-node(),
    map:map()
  )[1]
  let $_ := flow:set-default-options($options, $flow)

  (: this can throw, but we want the REST API to know about the problems, so let it :)
  let $envelope := runIngestHarmonize:run-flow($job-id, $flow, $uri, $content, $options)

  (: Insert the document into the STAGING database :)
  let $permissions := (xdmp:default-permissions(), xdmp:permission("rest-reader", "read"), xdmp:permission("rest-writer", "update"))
  let $collections := (xdmp:default-collections(), $entity-name, $ingest-flow-name, $consts:INPUT_FLOW)
  let $insertOptions :=
    <options xmlns="xdmp:document-insert">
      <permissions>{$permissions}</permissions>
      <collections>{
        for $collection in $collections
        return <collection>{$collection}</collection>
      }</collections>
    </options>
  let $_ := runIngestHarmonize:insert-document($uri, $envelope, $insertOptions)

  (: build all of the harmonization information :)
  let $harmonize-flow-name := map:get($params, 'harmonize-flow-name')
  let $flow := flow:get-flow($entity-name, $harmonize-flow-name, $consts:HARMONIZE_FLOW)
  let $_ :=
    if ($flow) then ()
    else
      fn:error(xs:QName("MISSING_FLOW"), "The specified flow " || $entity-name || ":" || $harmonize-flow-name || " is missing.")

  let $target-database :=
    if (fn:exists(map:get($params, "target-database"))) then
      xdmp:database(map:get($params, "target-database"))
    else
      xdmp:database($config:FINAL-DATABASE)
  (: add the target database to the harmonization options :)
  let $_ := (
    flow:set-default-options($options, $flow),
    map:put($options, "target-database", $target-database)
  )
  let $error :=
    try {
      runIngestHarmonize:run-flow($job-id, $flow, $uri, (), $options)
    }
    catch($ex) {
      xdmp:log(("caught error in run-ingest-harmonize.xqy")),
      xdmp:log($ex/error:format-string),
      $ex/error:format-string
    }

  return
    document {
      element response {
        element ingestion {
          $envelope
        },
        element harmonization {
          if (fn:empty($error)) then (
            element harmonizationSuccessful {fn:true()},
            element errorFound {fn:false()}
          )
          else (
            element harmonizationSuccessful {fn:false()},
            element errorFound {fn:true()},
            element errorMessage {$error}
          )
        }
      }
    }
};

declare private function runIngestHarmonize:run-flow(
  $job-id as xs:string,
  $flow as element(hub:flow),
  $uri as xs:string,
  $content as node()?,
  $options as map:map)
{
  (: The PUT command runs in update mode, so we need to eval in query mode :)
  xdmp:eval('
    import module namespace flow = "http://marklogic.com/data-hub/flow-lib"
      at "/data-hub/4/impl/flow-lib.xqy";

    declare variable $job-id external;
    declare variable $flow external;
    declare variable $uri external;
    declare variable $content external;
    declare variable $options external;

    flow:run-flow($job-id, $flow, $uri, $content, $options)
  ',
  map:new((
    map:entry("job-id", $job-id),
    map:entry("flow", $flow),
    map:entry("uri", $uri),
    map:entry("content", $content),
    map:entry("options", $options)
  )))
};

declare private function runIngestHarmonize:insert-document(
  $uri as xs:string,
  $root as node(),
  $options as element()?) as empty-sequence()
{
  (: We need to evaluate the insert in a separate transaction so that it is visible to the harmonization flow :)
  xdmp:eval('
    declare variable $uri external;
    declare variable $root external;
    declare variable $options external;
    declare variable $collections external;

    xdmp:document-insert($uri, $root, $options)
  ',
  map:new((
    map:entry("uri", $uri),
    map:entry("root", $root),
    map:entry("options", $options)
  )))
};


more anonymization on email

more anonymization on email

import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace csd_lsc = "https://github.com/openhie/openinfoman/csd_lsc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace anonymize = "https://github.com/openhie/openinfoman-anon";
import module namespace functx = "http://www.functx.com";

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

declare variable $careServicesRequest as item() external;

let $dest_doc := /.
let $dest := $careServicesRequest/@resource

let $values_doc := "anonymous/bible.xml"
let $fac_values_doc := "anonymous/star.xml"

let $values_src_0 := db:open($csd_webconf:db,  $values_doc)
let $values_src_1 :=
 if (count($values_src_0//value[1]) > 0)
 then $values_src_0
 else
   let $number-for-a := string-to-codepoints('A')
   let $number-for-z := string-to-codepoints('Z')

   let $values_src :=
     <values>
       {
	 for $letter in ($number-for-a to $number-for-z)
	 let $url := concat('http://en.wikipedia.org/wiki/List_of_biblical_names_starting_with_', codepoints-to-string($letter))
	 let $resp := http:send-request(<http:request method='get' href="{$url}"/>)
 	   for $li in $resp/html/body//div[@id="mw-content-text"]/ul[1]/li
	   let $text := string-join(($li/a[1]/text(),$li/text()))
	   let $name := tokenize($text,'\W+')[1]
	   return <value>{functx:trim($name)}</value>
       }
     </values>
    return $values_src
let $values := $values_src_1//value/text()

let $fac_values_src_0 := db:open($csd_webconf:db,  $fac_values_doc)
let $fac_values_src_1 :=
 if (count($fac_values_src_0//value[1]) > 0)
 then $fac_values_src_0
 else
   let $fac_url := 'http://en.wikipedia.org/wiki/List_of_proper_names_of_stars_in_alphabetical_order'
   let $resp := http:send-request(<http:request method='get' href="{$fac_url}"/>)

   return
     <values>
       {
	 for $td in $resp//table[@class="wikitable"]//td[1]
	 let $text :=
	   functx:trim(string-join(($td/a[1]/text(),$td/text())))
	 return if ($text) then <value>{$text}</value> else ()
       }
     </values>

let $fac_values := $fac_values_src_1//value/text()

return
(
  if (count($values_src_0//value[1]) = 0)
  then
     if (db:exists($csd_webconf:db, $values_doc))
     then db:replace($csd_webconf:db, $values_src_1, $values_doc)
     else db:add($csd_webconf:db, $values_src_1, $values_doc)
  else ()
  ,
  if (count($fac_values_src_0//value[1]) = 0)
  then
     if (db:exists($csd_webconf:db, $fac_values_doc))
     then db:replace($csd_webconf:db, $fac_values_src_1, $fac_values_doc)
     else db:add($csd_webconf:db, $fac_values_src_1, $fac_values_doc)
  else ()
  ,
  for $doc  in $careServicesRequest/documents/document
    let $name := $doc/@resource
    let $src_doc :=
      if (not ($name = $dest)) then csd_dm:open_document($csd_webconf:db, $name)
      else ()
    let $anon_doc := anonymize:document($src_doc,$values,$fac_values,$fac_values)
    return   (csd_lsc:refresh_doc($dest_doc, $anon_doc))

)

module namespace anonymize = "https://github.com/openhie/openinfoman-anon";
import module namespace functx = "http://www.functx.com";

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

declare variable $anonymize:exclude_address := (
  'street',  'st',  'way',  'road',  'hwy',  'highway' , 'lane','ave','avenue', 'rd', 's', 'n', 'e','w','sw','nw','se','ne'
);

declare variable $anonymize:exclude_name := (
  'clinic','hospital','hosp','facility','health','primary','district','regional','referal','center','centre'
);

declare function anonymize:document2($src_doc,$provider_values,$organization_values,$facility_values) {
  $src_doc
};
declare function anonymize:document($src_doc,$provider_values,$organization_values,$facility_values) {
   <csd:CSD>
     <csd:organizationDirectory>
       {
	 for $org in $src_doc/csd:CSD/csd:organizationDirectory/csd:organization
	 return anonymize:organization($org,$organization_values)
       }
     </csd:organizationDirectory>
     <csd:facilityDirectory>
       {
	 for $fac in $src_doc/csd:CSD/csd:facilityDirectory/csd:facility
	 return anonymize:facility($fac,$facility_values)
       }
     </csd:facilityDirectory>
     <csd:serviceDirectory>{$src_doc/csd:CSD/csd:serviceDirectory/csd:service}</csd:serviceDirectory>
     <csd:providerDirectory>
       {
	 for $provider in $src_doc/csd:CSD/csd:providerDirectory/csd:provider
	 return anonymize:provider($provider,$provider_values,$facility_values)
       }
     </csd:providerDirectory>
   </csd:CSD>
};

declare function anonymize:scramble($source) {
  let $tokens := functx:chars($source)
  let $all :=
      for $p in (1 to count($tokens))
      let $t := $tokens[$p]
      return
	 if (matches($t,'\d'))
	 then string(random:integer(max((0,9)))+1)
	 else $t
  return string-join($all,'')

};

declare function anonymize:replace-word($source,$values) {
  anonymize:replace-word($source,$values,map {})
};

declare function anonymize:replace-word($source,$values,$map) {
  anonymize:replace-word($source,$values,$map,())
};

declare function anonymize:replace-word($source,$values,$map,$excludes) {
  let $mapped := map:get($map,$source)
  return
    if ($mapped)
    then $mapped
    else if ($excludes = lower-case($source) )
    then $source
    else if (matches($source,"\d"))
    then anonymize:scramble($source)
    else
      let $rand := random:integer(count($values)) + 1
      return $values[$rand]
};

declare function anonymize:replace-string($source,$values){
  anonymize:replace-string($source,$values,map {})
};

declare function anonymize:replace-string($source,$values,$map) {
  anonymize:replace-string($source,$values,$map,())
};

declare function anonymize:replace-string($source,$values,$map,$excludes) {
  (:tokenize the $source text on non-letters, replace with value and join:)
  let $tokens := tokenize($source,'\W+')
  let $joins := tokenize($source,'\w+')
  let $anons :=
    for $t in $tokens
    return anonymize:replace-word($t,$values,$map,$excludes)
  let $count := max((count($anons), count($joins)))
  let $all :=
    if (matches($source,'^\W+'))
    then
      for $p in (0 to $count)
      return ($anons[$p],$joins[$p])
    else
      for $p in (0 to $count)
      return ($joins[$p],$anons[$p])
  return string-join($all)

};

declare function  anonymize:organization($organization,$values) {
  anonymize:organization($organization,$values,map{})
};

declare function  anonymize:organization($organization,$values,$map) {
  copy $org  := $organization
  modify (
    let $anon_name := anonymize:replace-string($org/csd:primaryName,$values,$map ,$anonymize:exclude_name)
    return replace value of node $org/csd:primaryName with $anon_name
    ,
    for $cp in $org/csd:contactPoint
    let $anon_cp :=
      if (string($cp/@code) = 'EMAIL')
      then
        <csd:contactPoint>
          <csd:codedType code="{$cp/csd:codedType/@code}" codingScheme="{$cp/csd:codedType/@codingScheme}">someone@nowhere.com</csd:codedType>
	</csd:contactPoint>
      else
        <csd:contactPoint>
          <csd:codedType code="{$cp/csd:codedType/@code}" codingScheme="{$cp/csd:codedType/@codingScheme}">{anonymize:scramble($cp/csd:codedType/text())}</csd:codedType>
	</csd:contactPoint>
    return replace node $cp with $anon_cp
    ,
    for $addr in $org/csd:address
      for $line in $addr/csd:addressLine[@component = 'streetAddress' or @component = 'StreetAddress' or @component = 'city']
      let $anon_addr := anonymize:replace-string($line/text(),$values,$map, $anonymize:exclude_address)
      return  replace value of node $line with $anon_addr
    ,
    for $contact_name in $org/csd:contact/csd:person/csd:name
    let $anon_name := anonymize:provider-name($contact_name,$values)
    return replace node $contact_name with $anon_name
    ,
    for $addr in $org/csd:contact/csd:person/csd:address
      for $line in $addr/csd:addressLine[@component = 'streetAddress' or @component = 'StreetAddress' or @component = 'city']
      let $anon_addr := anonymize:replace-string($line/text(),$values,$map, $anonymize:exclude_address)
      return replace value of node $line with $anon_addr

  )
  return $org
};

declare function  anonymize:facility($facility,$values) {
  anonymize:facility($facility,$values,map {})
};

declare function  anonymize:facility($facility,$values,$map) {
  copy $fac  := $facility
  modify (
    let $anon_name := anonymize:replace-string($fac/csd:primaryName,$values,$map,$anonymize:exclude_name)
    return replace value of node $fac/csd:primaryName with $anon_name
    ,
    for $cp in $fac/csd:contactPoint
    let $anon_cp :=
      <csd:contactPoint>
        <csd:codedType code="{$cp/csd:codedType/@code}" codingScheme="{$cp/csd:codedType/@codingScheme}">{anonymize:scramble($cp/csd:codedType/text())}</csd:codedType>
      </csd:contactPoint>
    return replace node $cp with $anon_cp
    ,
    for $addr in $fac/csd:address
      for $line in $addr/csd:addressLine[@component = 'streetAddress' or @component = 'StreetAddress' or  @component = 'city']
      let $anon_addr :=  anonymize:replace-string($line/text(),$values,$map,$anonymize:exclude_address)
      return replace value of node $line with $anon_addr
    ,
    for $contact_name in $fac/csd:contact/csd:person/csd:name
    let $anon_name := anonymize:provider-name($contact_name,$values)
    return replace node $contact_name with $anon_name
    ,
    for $addr in $fac/csd:contact/csd:person/csd:address
      for $line in $addr/csd:addressLine[@component = 'streetAddress' or @component = 'StreetAddress' or  @component = 'city']
      let $anon_addr := anonymize:replace-string($line/text(),$values,$map, $anonymize:exclude_address)
      return replace value of node $line with $anon_addr

  )
  return $fac
};

declare function anonymize:provider($provider,$values,$addr_values) {
  anonymize:provider($provider,$values,$addr_values,map {})
};

declare function anonymize:provider($provider,$values,$addr_values,$map) {
  copy $prov := $provider
  modify (
    for $name in $prov/csd:demographic/csd:name
    let $anon_name := anonymize:provider-name($name,$values)
    return replace node $name with $anon_name
    ,
    for $cp in $prov/csd:demographic/csd:contactPoint
      let $anon_cp :=
      <csd:contactPoint>
        <csd:codedType code="{$cp/csd:codedType/@code}" codingScheme="{$cp/csd:codedType/@codingScheme}">{anonymize:scramble($cp/csd:codedType/text())}</csd:codedType>
      </csd:contactPoint>
      return replace node $cp with $anon_cp
    ,
    for $addr in $prov/csd:demographic/csd:address
      for $line in $addr/csd:addressLine[@component = 'streetAddress' or @component = 'StreetAddress' or @component = 'city']
      let $anon_addr := anonymize:replace-string($line/text(),$addr_values,$map, $anonymize:exclude_address)
      return  replace value of node $line with $anon_addr

    )
  return $prov

};

declare function anonymize:provider-name($name,$values) {
(: Example Input:
				<name>
					<commonName>Banargee, Dev</commonName>
					<honorific>Dr.</honorific>
					<forename>Dev</forename>
					<surname>Banerjee</surname>
				</name>
:)
    let $honor :=  ($name/csd:honorific)[1]/text()
    let $sur :=  ($name/csd:surname)[1]/text()
    let $fore :=  ($name/csd:foreame)[1]/text()
    let $common :=  ($name/csd:commonName)[1]/text()
    let $anon_sur := anonymize:replace-string($sur,$values)
    let $anon_fore := anonymize:replace-string($fore,$values)

    let $map_0 :=
      if ($honor)
      then map {$honor: $honor}
      else map {}
    let $map_1 :=
      if ($anon_sur)
      then map:put($map_0,$sur,$anon_sur)
      else $map_0
    let $map_2 :=
      if ($anon_fore)
      then map:put($map_0,$fore,$anon_fore)
      else $map_1

    let $anon_common := anonymize:replace-string($common,$values,$map_2)
    let $anon_name :=
      <csd:name>
         <csd:commonName>{$anon_common}</csd:commonName>
	 {if ($honor) then <csd:honorific>{$honor}</csd:honorific> else () }
	 {if ($anon_fore) then	 <csd:forename>{$anon_fore}</csd:forename> else () }
	 {if ($anon_sur) then  <csd:surname>{$anon_sur}</csd:surname> else () }
      </csd:name>
    return $anon_name
};


[apidoc] Don't include the REST functions in the apidocs.

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

declare namespace apidoc = "http://marklogic.com/xdmp/apidoc";
declare namespace map = "http://www.w3.org/2005/xpath-functions/map";

declare variable $apidoc as element(apidoc:apidoc) :=
    typeswitch (.)
    case xs:string return fn:parse-xml(.)/element()
    case document-node() return ./element()
    default return .;

declare variable $language as xs:string := "xquery"; (: xquery | rest :)

(: functions --------------------------------------------------------------- :)

(: Several functions in the apidocs have duplicate parameter names in some versions, so fix these. :)
declare variable $param-fixes := map {
    "fn:subtract-dateTimes-yielding-dayTimeDuration": ("srcval1", "srcval2"),
    "fn:subtract-dateTimes-yielding-yearMonthDuration": ("srcval1", "srcval2"),
    "math:fmod": ("x", "y"),
    "math:rank": ("arg1", "arg2", "options")
};

declare variable $functions as element(apidoc:function)* := $apidoc//apidoc:function[
    local:function-language(.) = $language
];

declare function local:function-language($function as element(apidoc:function)) as xs:string {
    let $bucket := $function/@bucket
    return switch ($bucket)
    case "REST Resources API" return "rest"
    default return "xquery"
};

declare function local:function-name($function as element(apidoc:function)) as xs:string {
    ``[`{$function/@lib}`:`{$function/@name}`]``
};

declare function local:function-parameters($function as element(apidoc:function)) as xs:string* {
    let $names as xs:string* :=
        let $names := map:get($param-fixes, local:function-name($function))
        return if (exists($names)) then
            $names
        else
            $function/apidoc:params/apidoc:param/@name/string()
    return if (count($names) != count(distinct-values($names))) then
        fn:error(xs:QName("err:XQST0039"),``[Duplicate parameter name in `{local:function-name($function)}`]``)
    else
        $names
};

declare function local:function-parameter($function as element(apidoc:function), $name as xs:string) as element(apidoc:param) {
    let $names := map:get($param-fixes, local:function-name($function))
    return if (exists($names)) then
        let $i := fn:index-of($names, $name)
        return $function/apidoc:params/apidoc:param[$i]
    else
        $function/apidoc:params/apidoc:param[@name = $name]
};

declare function local:function-parameter-type($function as element(apidoc:function), $name as xs:string) as xs:string {
    local:function-parameter($function, $name)/@type
};

declare function local:function-return-type($function as element(apidoc:function)) as xs:string {
    $function/apidoc:return
};

declare function local:function-xquery-signatures($function as element(apidoc:function)) as xs:string* {
    let $name := local:function-name($function)
    let $params :=
        for $name in local:function-parameters($function)
        let $type := local:function-parameter-type($function, $name)
        return ``[$`{$name}` as `{$type}`]``
    let $type := local:function-return-type($function)
    return ``[declare function `{$name}`(`{string-join($params, ", ")}`) as `{$type}` external;]``
};

(: query ------------------------------------------------------------------- :)

for $function in $functions
order by $function/@lib, $function/@name
return local:function-xquery-signatures($function)

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

declare namespace apidoc = "http://marklogic.com/xdmp/apidoc";
declare namespace map = "http://www.w3.org/2005/xpath-functions/map";

declare variable $apidoc as element(apidoc:apidoc) :=
    typeswitch (.)
    case xs:string return fn:parse-xml(.)/element()
    case document-node() return ./element()
    default return .;

(: functions --------------------------------------------------------------- :)

(: Several functions in the apidocs have duplicate parameter names in some versions, so fix these. :)
declare variable $param-fixes := map {
    "fn:subtract-dateTimes-yielding-dayTimeDuration": ("srcval1", "srcval2"),
    "fn:subtract-dateTimes-yielding-yearMonthDuration": ("srcval1", "srcval2"),
    "math:fmod": ("x", "y"),
    "math:rank": ("arg1", "arg2", "options")
};

declare variable $functions as element(apidoc:function)* := $apidoc//apidoc:function;

declare function local:function-name($function as element(apidoc:function)) as xs:string {
    ``[`{$function/@lib}`:`{$function/@name}`]``
};

declare function local:function-parameters($function as element(apidoc:function)) as xs:string* {
    let $names as xs:string* :=
        let $names := map:get($param-fixes, local:function-name($function))
        return if (exists($names)) then
            $names
        else
            $function/apidoc:params/apidoc:param/@name/string()
    return if (count($names) != count(distinct-values($names))) then
        fn:error(xs:QName("err:XQST0039"),``[Duplicate parameter name in `{local:function-name($function)}`]``)
    else
        $names
};

declare function local:function-parameter($function as element(apidoc:function), $name as xs:string) as element(apidoc:param) {
    let $names := map:get($param-fixes, local:function-name($function))
    return if (exists($names)) then
        let $i := fn:index-of($names, $name)
        return $function/apidoc:params/apidoc:param[$i]
    else
        $function/apidoc:params/apidoc:param[@name = $name]
};

declare function local:function-parameter-type($function as element(apidoc:function), $name as xs:string) as xs:string {
    local:function-parameter($function, $name)/@type
};

declare function local:function-return-type($function as element(apidoc:function)) as xs:string {
    $function/apidoc:return
};

declare function local:function-xquery-signatures($function as element(apidoc:function)) as xs:string* {
    let $name := local:function-name($function)
    let $params :=
        for $name in local:function-parameters($function)
        let $type := local:function-parameter-type($function, $name)
        return ``[$`{$name}` as `{$type}`]``
    let $type := local:function-return-type($function)
    return ``[declare function `{$name}`(`{string-join($params, ", ")}`) as `{$type}` external;]``
};

(: query ------------------------------------------------------------------- :)

for $function in $functions
order by $function/@lib, $function/@name
return local:function-xquery-signatures($function)