graph bars now ordered acording to length

xquery version "3.0";
declare namespace tei = "http://www.tei-c.org/ns/1.0";
declare variable $poets := doc('/db/VTLGP/ancillary/corpus-autores.xml')//tei:person;
declare variable $songs := collection('/db/VTLGP/edition')//tei:div[@type eq 'poem'];
declare variable $periods := $poets[@xml:id = $songs//tei:name/substring(@ref, 2)]/tei:floruit/@period;
declare variable $witnesses := $songs//tei:title//tei:rdg/@wit;
declare variable $copyists := $songs//tei:title//tei:rdg/@hand;
declare variable $count := count($songs);

Cantigas segundo o períodoSongs by period

    <svg
        xmlns="http://www.w3.org/2000/svg"
        width="950"
        height="{(count(distinct-values($periods)) + 2) * 20}">
        {

            for $period at $pos in distinct-values($periods)
            let $sum := count($songs[.//tei:name/substring(@ref, 2) = $poets[./tei:floruit/@period eq $period]/@xml:id])
            let $percentage := round-half-to-even((100 * $sum div $count), 2)
            return
                <g>
                    <rect
                        fill="#2B3966"
                        height="20"
                        width="{$sum * 6.5}"
                        x="100"
                        y="{$pos * 20}"
                        stroke="#EAE5C5"
                        stroke-width="2"/>
                    <text
                        fill="black"
                        font-size="12"
                        x="{110 + $sum * 6.5}"
                        y="{$pos * 20 + 14}"
                    >{' (' || $percentage || '%)'}</text>
                    <text
                        class="pt"
                        fill="black"
                        x="10"
                        y="{$pos * 20 + 18}"
                    >Período {$period}</text>
                    <text
                        class="en"
                        fill="black"
                        x="10"
                        y="{$pos * 20 + 18}"
                    >Period {$period}</text>
                </g>
        }</svg>

Cantigas por testemunhoSongs by witness

    <svg
        xmlns="http://www.w3.org/2000/svg"
        width="100%"
        height="{(count(distinct-values($witnesses)) + 2) * 20}">
        {

            for $wit at $pos in distinct-values($witnesses)
            let $sum := count($songs[.//tei:title//tei:rdg/@wit = $wit])
            let $percentage := round-half-to-even((100 * $sum div $count), 2)
            return
                <g>
                    <rect
                        fill="blue"
                        height="20"
                        width="{$sum * 6.5}"
                        x="70"
                        y="{$pos * 20}"
                        stroke="#EAE5C5"
                    />
                    <text
                        fill="black"
                        font-size="12"
                        x="{80 + $sum * 6.5}"
                        y="{$pos * 20 + 14}"
                    >{' (' || $percentage || '%)'}</text>
                    <text
                        fill="black"
                        x="10"
                        y="{$pos * 20 + 18}"
                    >Ms. {substring($wit, 2)}</text>

                    {
                        let $hand := $songs/tei:head//tei:rdg[@wit = $wit]/@hand
                        let $distinctHands := distinct-values($hand)
                        for $h in 1 to count($distinctHands)
                        let $x := count($songs[.//tei:head//tei:rdg[@wit = $wit][@hand = $distinctHands[position() lt $h]]])
                        let $div := $songs[tei:head//tei:rdg[@wit = $wit][@hand = $distinctHands[$h]]]
                        let $conta := count($div)
                        order by $h descending
                        return

                            (<rect
                                fill="#2B3966"
                                height="20"
                                width="{$conta * 6.5}"
                                x="{$x * 6.5 + 70}"
                                y="{$pos * 20}"
                                stroke="#EAE5C5"
                                stroke-width="2"/>,
                            <text
                                fill="white"
                                font-size="10.5"
                                x="{($x * 6.5 + 68) + (($conta * 6.5) div 2)}"
                                y="{$pos * 20 + 12}">{substring($distinctHands[$h], 2)}</text>)

                    }</g>
        }</svg>

Cantigas segundo o copistaSongs by scribe

    <svg
        xmlns="http://www.w3.org/2000/svg"
        width="100%"
        height="{(count(distinct-values($copyists)) + 2) * 20}">
        {
            let $variables :=
            <variables>{

                    for $hand in distinct-values($copyists)
                    let $sum := count($songs[.//tei:title//tei:rdg/@hand = $hand])
                    let $percentage := round-half-to-even((100 * $sum div $count), 2)
                    order by $sum descending
                    return
                        <item>
                            <sum>{$sum}</sum>
                            <percentage>{$percentage}</percentage>
                            <hand>{$hand}</hand>
                        </item>
                }</variables>
            for $thing at $pos in $variables/item
            return
                <g>
                    <rect
                        fill="#2B3966"
                        height="20"
                        width="{$thing/sum * 6.5}"
                        x="100"
                        y="{$pos * 20}"
                        stroke="#EAE5C5"
                        stroke-width="2"/>
                    <text
                        fill="black"
                        font-size="12"
                        x="{110 + $thing/sum * 6.5}"
                        y="{$pos * 20 + 14}"
                    >{' (' || $thing/percentage || '%)'}</text>
                    <text
                        class="pt"
                        fill="black"
                        x="10"
                        y="{$pos * 20 + 18}"
                    >Copista {substring($thing/hand, 2)}</text>
                    <text
                        class="en"
                        fill="black"
                        x="10"
                        y="{$pos * 20 + 18}"
                    >Copyist {substring($thing/hand, 2)}</text>
                </g>
        }</svg>

xquery version "3.0";
declare namespace tei = "http://www.tei-c.org/ns/1.0";
let $poets := doc('/db/VTLGP/ancillary/corpus-autores.xml')//tei:person
let $songs := collection('/db/VTLGP/edition')//tei:div[@type eq 'poem']
let $periods := $poets[@xml:id = $songs//tei:name/substring(@ref, 2)]/tei:floruit/@period
let $witnesses := $songs//tei:title//tei:rdg/@wit
let $copyists := $songs//tei:title//tei:rdg/@hand

return

Cantigas segundo o períodoSongs by period

        <svg
            xmlns="http://www.w3.org/2000/svg"
            width="950"
            height="{(count(distinct-values($periods)) + 2) * 20}">
            {

                for $period at $pos in distinct-values($periods)
                let $count := count($songs)
                let $sum := count($songs[.//tei:name/substring(@ref, 2) = $poets[./tei:floruit/@period eq $period]/@xml:id])
                let $percentage := round-half-to-even((100 * $sum div $count), 2)
                order by count($sum) descending
                return
                    <g>
                        <rect
                            fill="#2B3966"
                            height="20"
                            width="{$sum * 6.5}"
                            x="100"
                            y="{$pos * 20}"
                            stroke="#EAE5C5"
                            stroke-width="2"/>
                        <text
                            fill="black"
                            font-size="12"
                            x="{110 + $sum * 6.5}"
                            y="{$pos * 20 + 14}"
                        >{' (' || $percentage || '%)'}</text>
                        <text
                            class="pt"
                            fill="black"
                            x="10"
                            y="{$pos * 20 + 18}"
                        >Período {$period}</text>
                        <text
                            class="en"
                            fill="black"
                            x="10"
                            y="{$pos * 20 + 18}"
                        >Period {$period}</text>
                    </g>
            }</svg>

Cantigas por testemunhoSongs by witness

        <svg
            xmlns="http://www.w3.org/2000/svg"
            width="100%"
            height="{(count(distinct-values($witnesses)) + 2) * 20}">
            {

                for $wit at $pos in distinct-values($witnesses)
                let $count := count($songs)
                let $sum := count($songs[.//tei:title//tei:rdg/@wit = $wit])
                let $percentage := round-half-to-even((100 * $sum div $count), 2)
                order by $count descending
                return
                    <g>
                        <rect
                            fill="blue"
                            height="20"
                            width="{$sum * 6.5}"
                            x="70"
                            y="{$pos * 20}"
                            stroke="#EAE5C5"
                        />
                        <text
                            fill="black"
                            font-size="12"
                            x="{80 + $sum * 6.5}"
                            y="{$pos * 20 + 14}"
                        >{' (' || $percentage || '%)'}</text>
                        <text
                            fill="black"
                            x="10"
                            y="{$pos * 20 + 18}"
                        >Ms. {substring($wit, 2)}</text>

                        {
                            let $hand := $songs/tei:head//tei:rdg[@wit = $wit]/@hand
                            let $distinctHands := distinct-values($hand)
                            for $h in 1 to count($distinctHands)
                            let $x := count($songs[.//tei:head//tei:rdg[@wit = $wit][@hand = $distinctHands[position() lt $h]]])
                            let $div := $songs[tei:head//tei:rdg[@wit = $wit][@hand = $distinctHands[$h]]]
                            let $conta := count($div)
                            order by $h descending
                            return

                                (<rect
                                    fill="#2B3966"
                                    height="20"
                                    width="{$conta * 6.5}"
                                    x="{$x * 6.5 + 70}"
                                    y="{$pos * 20}"
                                    stroke="#EAE5C5"
                                    stroke-width="2"/>,
                                <text
                                    fill="white"
                                    font-size="10.5"
                                    x="{($x * 6.5 + 68) + (($conta * 6.5) div 2)}"
                                    y="{$pos * 20 + 12}">{substring($distinctHands[$h], 2)}</text>)

                        }</g>
            }</svg>

Cantigas segundo o copistaSongs by scribe

        <svg
            xmlns="http://www.w3.org/2000/svg"
            width="100%"
            height="{(count(distinct-values($copyists)) + 2) * 20}">
            {

                for $hand at $pos in distinct-values($copyists)
                let $count := count($songs)
                let $sum := count($songs[.//tei:title//tei:rdg/@hand = $hand])
                let $percentage := round-half-to-even((100 * $sum div $count), 2)
                order by count($sum) descending
                return
                    <g>
                        <rect
                            fill="#2B3966"
                            height="20"
                            width="{$sum * 6.5}"
                            x="100"
                            y="{$pos * 20}"
                            stroke="#EAE5C5"
                            stroke-width="2"/>
                        <text
                            fill="black"
                            font-size="12"
                            x="{110 + $sum * 6.5}"
                            y="{$pos * 20 + 14}"
                        >{' (' || $percentage || '%)'}</text>
                        <text
                            class="pt"
                            fill="black"
                            x="10"
                            y="{$pos * 20 + 18}"
                        >Copista {substring($hand, 2)}</text>
                        <text
                            class="en"
                            fill="black"
                            x="10"
                            y="{$pos * 20 + 18}"
                        >Copyist {substring($hand, 2)}</text>
                    </g>
            }</svg>


[ignore] empty sequence not allowed

[ignore] empty sequence not allowed

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

xquery version "1.0";

(:
    Module: Browse Indexes: See an overview of .xconf files stored in /db/system/config,
    and browse the associated index keys.
:)

module namespace indexes="http://exist-db.org/xquery/admin-interface/indexes";

declare namespace cc="http://exist-db.org/collection-config/1.0";

declare option exist:serialize "method=xhtml media-type=text/html omit-xml-declaration=no enforce-xhtml=yes";

(:
    Global variables - derived from URL parameters
:)
declare variable $indexes:start-value := request:get-parameter('start-value', '');
declare variable $indexes:callback := util:function(xs:QName("indexes:term-callback"), 2);
declare variable $indexes:max-number-returned := xs:integer(request:get-parameter('max', 100));
declare variable $indexes:index := request:get-parameter('index', '');
declare variable $indexes:sortby := request:get-parameter('sortby', 'term');
declare variable $indexes:sortorder := request:get-parameter('sortorder', 'ascending');
declare variable $indexes:node-name := request:get-parameter('node-name', '');
declare variable $indexes:match := request:get-parameter('match', '');
declare variable $indexes:collection := request:get-parameter('collection', '');
declare variable $indexes:node-set :=
    if ($indexes:node-name ne '' and $indexes:collection ne '') then
        indexes:get-nodeset-from-qname($indexes:collection, $indexes:node-name)
    else if ($indexes:match ne '' and $indexes:collection ne '') then
        indexes:get-nodeset-from-match($indexes:collection, $indexes:match)
    else
        ();
declare variable $indexes:qname :=
    if ($indexes:node-name ne '') then
        if (not(matches($indexes:node-name, 'xml:')) and contains($indexes:node-name, ':')) then
            QName(indexes:get-namespace-uri-from-node-name($indexes:node-name, $indexes:collection), $indexes:node-name)
        else
            xs:QName($indexes:node-name)
    else ();
declare variable $indexes:show-keys-by := request:get-parameter('show-keys-by', '');
declare variable $indexes:index-names :=

        <name>Index Types</name>
        <description>This is the list of known index types and their labels.</description>
        <items>
            <item>
                Lucene
                <value>lucene-index</value>
            </item>
            <item>
                NGram
                <value>ngram-index</value>
            </item>
            <item>
                Range
                <value>range-index</value>
            </item>
            <item>
                Legacy Fulltext
                <value>legacy-fulltext-index</value>
            </item>
        </items>
    ;

(:
    Main function: outputs the page.
:)
declare function indexes:main() {
    let $xconfs :=
        for $xconf in collection('/db/system/config/')/cc:collection
        order by util:collection-name($xconf)
        return $xconf
    return
        if (empty($xconfs)) then

Browse Indexes

No Index Configurations were found in the /db/system/config collection.
                    Consider installing eXist's example files or
                    documentation and then returning here
                    to browse the indexes.

        else if (empty($indexes:node-set)) then

            indexes:list-indexes($xconfs)

        else

            indexes:show-index-keys()
};

(:
    Lists indexes.
:)
declare function indexes:list-indexes($xconfs) {

Browse Indexes

This is an overview of the index definitions applied in the database,
            as well as the "index keys" (the actual items stored in the index).

Browsing {count($xconfs)} indexes:

        { indexes:xconf-to-table($xconfs) }

};

(:
    Transforms an index definition into an HTML table.
:)
declare function indexes:xconf-to-table($xconfs as node()*) as item()* {

{
        for $xconf at $count in $xconfs
        let $xconf-collection-name := util:collection-name($xconf)
        let $data-collection-name := substring-after(util:collection-name($xconf), '/db/system/config')
        order by $xconf-collection-name
        return

                {$count}. {$data-collection-name} {if (xmldb:collection-available($data-collection-name)) then () else ' (no data)'}
                    (View xconf file)

                        Item Indexed
                        Index
                        Instances
                        Show Index Keys By

                    {
                    for $entry in ( indexes:analyze-legacy-fulltext-indexes($xconf),
                        indexes:analyze-lucene-indexes($xconf),
                        indexes:analyze-range-indexes($xconf),
                        indexes:analyze-ngram-indexes($xconf) )
                    let $item := $entry/td[1]
                    let $index := $entry/td[2]
                    (: order by $index, $item :)
                    return $entry
                    }

    }

};

(:
    Shows the index keys on a given nodeset or QName
:)
declare function indexes:show-index-keys() {
    let $query-start-time := util:system-time()

    let $keys :=
        (: legacy fulltext index use the text:index-terms() function :)
        if ($indexes:index eq 'legacy-fulltext-index') then
            text:index-terms($indexes:node-set, $indexes:start-value, $indexes:callback, $indexes:max-number-returned)
        (: range indexes can use util:index-keys() without specifying the index :)
        else if ($indexes:index eq 'range-index') then
            if (util:index-type($indexes:node-set) eq 'xs:string') then
                util:index-keys($indexes:node-set, $indexes:start-value, $indexes:callback, $indexes:max-number-returned)
            else
                let $start-value :=
                    if (util:index-type($indexes:node-set) eq 'xs:double') then
                        if ($indexes:start-value castable as xs:double) then xs:double($indexes:start-value) else xs:double(0)
                    else if (util:index-type($indexes:node-set) eq 'xs:float') then
                        if ($indexes:start-value castable as xs:float) then xs:float($indexes:start-value) else xs:float(0)
                    else if (util:index-type($indexes:node-set) eq 'xs:boolean') then
                        if ($indexes:start-value castable as xs:boolean) then xs:boolean($indexes:start-value) else xs:boolean(0)
                    else if (util:index-type($indexes:node-set) eq 'xs:dateTime') then
                        if ($indexes:start-value castable as xs:dateTime) then xs:dateTime($indexes:start-value) else xs:dateTime('0001-01-01T00:00:00-00:00')
                    else if (util:index-type($indexes:node-set) eq 'xs:date') then
                        if ($indexes:start-value castable as xs:date) then xs:date($indexes:start-value) else xs:date('0001-01-01')
                    else
                        if ($indexes:start-value castable as xs:integer) then xs:integer($indexes:start-value)
                    else 0
                return util:index-keys($indexes:node-set, $start-value, $indexes:callback, $indexes:max-number-returned)
        (: all other indexes need to specify the index in the 5th parameter of util:index-keys() :)
        else
            if ($indexes:show-keys-by eq 'node') then
                util:index-keys($indexes:node-set, $indexes:start-value, $indexes:callback, $indexes:max-number-returned, $indexes:index)
            else
                util:index-keys-by-qname($indexes:qname, $indexes:start-value, $indexes:callback, $indexes:max-number-returned, $indexes:index)

    let $log := util:log("DEBUG", concat("INDEXES index type:    ", $indexes:index))
    let $log := util:log("DEBUG", concat("INDEXES qname     :    ", $indexes:qname))

    (:  Reminder for sorting:
           term = $key/td[1]
           frequency := xs:integer($key/td[2])
           documents := xs:integer($key/td[3])
           position := xs:integer($key/td[4])
    :)

    let $sorted-keys :=
        if ($indexes:sortby eq 'term') then
            if ($indexes:sortorder eq 'ascending') then
                for $key in $keys order by $key/td[1] ascending return $key
            else
                for $key in $keys order by $key/td[1] descending return $key
        else if ($indexes:sortby eq 'frequency') then
            if ($indexes:sortorder eq 'ascending') then
                for $key in $keys order by xs:integer($key/td[2]) ascending, $key/td[1] ascending return $key
            else
                for $key in $keys order by xs:integer($key/td[2]) descending, $key/td[1] ascending return $key
        else if ($indexes:sortby eq 'documents') then
            if ($indexes:sortorder eq 'ascending') then
                for $key in $keys order by xs:integer($key/td[3]) ascending, $key/td[1] ascending return $key
            else
                for $key in $keys order by xs:integer($key/td[3]) descending, $key/td[1] ascending return $key
        else if ($indexes:sortby eq 'position') then
            if ($indexes:sortorder eq 'ascending') then
                for $key in $keys order by xs:integer($key/td[4]) ascending return $key
            else
                for $key in $keys order by xs:integer($key/td[4]) descending return $key
        else $keys

    let $query-end-time := util:system-time()
    let $query-duration := ($query-end-time - $query-start-time) div xs:dayTimeDuration('PT1S')

    return

View Index Keys

Select a different index

{count($keys)} keys returned in {$query-duration}s

Keys for the {indexes:index-name-to-label($indexes:index)} index defined on "{string-join(($indexes:node-name, $indexes:match), '')}" in the {$indexes:collection} collection, by {$indexes:show-keys-by}.

            <form method="get" action="{indexes:remove-parameter-names('start-value')}">

                    Max number returned: <select name="max">{
                        for $number in (10, 100, 1000, 10000)
                        return
                            <option value="{$number}">{if ($number eq $indexes:max-number-returned) then attribute selected {'selected'} else ()}{$number}</option>
                    }</select>

                    Search for terms starting with: <input name="start-value" type="text" value="{$indexes:start-value}"/>
                    {if ($indexes:start-value ne '') then Clear search else ()}
                    {
                    for $param in request:get-parameter-names()[not(. = ('max', 'start-value'))]
                    return
                        <input type="hidden" name="{$param}" value="{request:get-parameter($param, '')}"/>
                    }

                    <input type="submit"/>

            </form>

{
                    for $column in ('term', 'frequency', 'documents', 'position')
                    return
                        {$column} {indexes:sort-direction-indicator($column)}
                }

                { $sorted-keys }

};

(:
    Helper function: Callback function called used in indexes:show-index-keys() for util:index-keys()
:)
declare function indexes:term-callback($term as xs:string, $data as xs:int+) as element() {

        {$term}
        {$data[1]}
        {$data[2]}
        {$data[3]}

};

(:
    Analyzes the Lucene indexes in an index definition
:)
declare function indexes:analyze-lucene-indexes($xconf) {
    let $index-label := indexes:index-name-to-label('lucene-index')
    let $lucene := $xconf/cc:index/cc:lucene
    return if (not($lucene) or not($lucene/cc:text)) then () else
        (
        (: TODO: complete report of default/other Lucene analyzers :)
        (:let $analyzers := $lucene/cc:analyzer
        return
            if ($analyzers) then
                (

Lucene Analyzers

                ,
                for $node in $analyzers
                return
                    if (not($node/@id)) then

default: {concat(' ', $node/@class/string())}

                    else

{$node/@id/string()}: {concat(' ', $node/@class/string())}

                )
            else ()
        ,:)
        let $texts := $lucene//cc:text
        return
            (
            for $text in $texts
            let $qname := if ($text/@qname) then $text/@qname/string() else ()
            let $match := if ($text/@match) then $text/@match/string() else ()
            let $analyzer := if ($text/@analyzer) then $text/@analyzer/string() else ()
            let $collection := substring-after(util:collection-name($text), '/db/system/config')
            let $nodeset := if ($qname) then indexes:get-nodeset-from-qname($collection, $qname) else indexes:get-nodeset-from-match($collection, $match)
            return

                        {if ($qname) then $qname else $match}
                        {if ($text/@boost) then concat(' (boost: ', $text/@boost/string(), ')') else ()}
                        {if ($text/cc:ignore) then (
, concat('(ignore: ', string-join(for $ignore in $text/cc:ignore return $ignore/@qname/string(), ', '), ')')) else ()}
                    {$index-label} {if ($qname) then ' QName' else ' Match'} {if ($analyzer) then concat(' (', $analyzer, ')') else ' (default analyzer)' (: TODO: complete report of default/other Lucene analyzers :)}
                    {count($nodeset)}
                    {
                        if (empty($nodeset)) then ()
                        else
                            (
                            QName
                            ,
                            ', '
                            ,
                            Node
                            )
                    }

            )
        )
};

(:
    Analyzes the legacy fulltext indexes in an index definition
:)
declare function indexes:analyze-legacy-fulltext-indexes($xconf) {
    let $collection := substring-after(util:collection-name($xconf), '/db/system/config')
    let $index := 'legacy-fulltext-index'
    let $index-label := indexes:index-name-to-label($index)
    let $fulltext := $xconf/cc:index/cc:fulltext
    let $creates := $fulltext/cc:create
    let $default-none := $fulltext/@default eq 'none'
    let $attributes-none := $fulltext/@attributes eq 'false'

    let $no-fulltext := if ( not($fulltext) or ($default-none and $attributes-none and not($creates)) ) then '(disabled)' else ()
    return
        if ($no-fulltext) then ()
        else if (not($default-none) and not($attributes-none)) then

                All Elements and Attributes!
                {$index-label}
                {count(collection($collection)//*)} elements and {count(collection($collection)//@*)} attributes
                (Too many to display)

(: is it feasible to display all qnames/nodes here? :)
        else (: if ($creates) then :)
            (
            for $create in $creates
            let $qname := $create/@qname/string()
            let $mixed := $create/@mixed/string()
            return

                    {$qname}
                    {$index-label} {if ($mixed) then '(mixed)' else ()}
                    {count(util:eval(concat('collection(', $collection, ')//', $qname)))}
                    Node

            ,
            let $only-elements-disabled := if ($fulltext/@default eq 'none' and $fulltext/@attributes ne 'no') then '(elements disabled)' else ()
            let $only-attribs-disabled := if ($fulltext/@default ne 'none' and $fulltext/@attributes eq 'no') then '(attributes disabled)' else ()
            return
            if ($only-elements-disabled) then

                    All Attributes!
                    {$index-label}
                    {count(collection($collection)//@*)} attributes
                    (Too many to display)

(: is it feasible to display all qnames/nodes here? :)
            else if ($only-attribs-disabled) then

                    All Elements!
                    {$index-label}
                    {count(collection($collection)//*)} elements
                    (Too many to display)

(: is it feasible to display all qnames/nodes here? :)
            else ()
            )
};

(:
    Analyzes the range indexes in an index definition
:)
declare function indexes:analyze-range-indexes($xconf) {
    let $index-label := indexes:index-name-to-label('range-index')
    let $ranges := $xconf/cc:index/cc:create
    return if (not($ranges)) then () else
        for $range in $ranges
        let $qname := $range/@qname/string()
        let $match := $range/@path/string()
        let $type := $range/@type/string()
        let $collection := substring-after(util:collection-name($range), '/db/system/config')
        let $nodeset := if ($qname) then indexes:get-nodeset-from-qname($collection, $qname) else indexes:get-nodeset-from-match($collection, $match)
        return

                {if ($qname) then $qname else $match}
                {$index-label} {if ($qname) then ' QName' else ' Path'} ({$type})
                {count($nodeset)}
                {
                    if (empty($nodeset)) then ()
                    else
                        Node
                }

};

(:
    Analyzes the NGram indexes in an index definition
:)
declare function indexes:analyze-ngram-indexes($xconf) {
    let $index-label := indexes:index-name-to-label('ngram-index')
    let $ngrams := $xconf/cc:index/cc:ngram
    return if (not($ngrams)) then () else
        for $ngram in $ngrams
        let $qname := $ngram/@qname/string()
        let $collection := substring-after(util:collection-name($ngram), '/db/system/config')
        let $nodeset := indexes:get-nodeset-from-qname($collection, $qname)
        return

                {$qname}
                {$index-label} QName
                {count($nodeset)}
                {
                    if (not(empty($nodeset))) then
                        (
                        QName,
                        ', '
                        ,
                        Node
                        )
                     else ()
                 }

};

(:
    Helper function: Returns a nodeset of instances of a node-name in a collection
:)
declare function indexes:get-nodeset-from-qname($collection as xs:string, $node-name as xs:string) as node()* {
    let $nodeset-expression :=
        concat(
            indexes:get-namespace-declaration-from-node-name($node-name, $collection)
            ,
            'collection("', $collection, '")//', $node-name
        )
    let $log := util:log("DEBUG", concat("INDEXES get-nodeset:          ", $nodeset-expression))
    return
        util:eval($nodeset-expression)
};

(:
    Helper function: Returns a nodeset of instances of a match expression in a collection
:)
declare function indexes:get-nodeset-from-match($collection as xs:string, $match as xs:string) as node()* {
    let $nodeset-expression :=
        concat(
            string-join(
                distinct-values(
                let $node-names := tokenize(replace($match, '//', '/'), '/')
                return
                    for $node-name in $node-names
                    return
                        indexes:get-namespace-declaration-from-node-name($node-name, $collection)
                ), ' ')
            ,
            'collection("', $collection, '")', $match, if (contains($match, '@')) then () else ()
        )
    return
        util:eval($nodeset-expression)
};

(:
    Helper function: Returns the index definition for a given collection
:)
declare function indexes:get-xconf($collection as xs:string) as document-node() {
    let $config-root := '/db/system/config'
    let $xconf-collection := concat($config-root, $collection)
    let $xconf-filename := xmldb:get-child-resources($xconf-collection)[ends-with(., '.xconf')]
    let $xconf := doc(concat($xconf-collection, '/', $xconf-filename))
    return $xconf
};

(:
    Helper function: Looks in the collection.xconf's collection and index elements for namespace URIs for a given node name
:)
declare function indexes:get-namespace-uri-from-node-name($node-name, $collection) {

    let $name := if (starts-with($node-name,'@')) then
                    substring-after( substring-before($node-name, ':'), '@' )
                else
                    substring-before($node-name, ':')

    let $xconf := indexes:get-xconf($collection)
    let $uri := (namespace-uri-for-prefix($name, $xconf/cc:collection), namespace-uri-for-prefix($name, $xconf//cc:index))
    return
        $uri
};

(:
    Helper function: Constructs a namespace declaration for use in util:eval()
:)
declare function indexes:get-namespace-declaration-from-node-name($node-name as xs:string, $collection as xs:string) as xs:string? {
    if (not(matches($node-name, 'xml:')) and contains($node-name, ':')) then

        let $name := if (starts-with($node-name,'@')) then
                        substring-after( substring-before($node-name, ':'), '@' )
                    else
                        substring-before($node-name, ':')

        let $uri := indexes:get-namespace-uri-from-node-name($node-name, $collection)
        return
            concat('declare namespace ', $name, '="', $uri, '"; ')
    else ()
};

(:
    Helper function: gets the label for a given index-name
:)
declare function indexes:index-name-to-label($index-name as xs:string) as xs:string {
    $indexes:index-names//item[value eq $index-name]/label/text()
};

(:
    ====
    Helper functions for modifying the sort order used in indexes:show-index-keys()
    ====
:)
declare function indexes:toggle-sortorder($current-sortorder) {
    indexes:toggle-sortorder($current-sortorder, ('ascending'))
};

declare function indexes:toggle-sortorder($current-sortorder, $other-new-parameters) {
    let $neworder :=
        if ($current-sortorder eq 'ascending') then
            'sortorder=descending'
        else
            'sortorder=ascending'
    let $new-parameters := ($neworder, $other-new-parameters)
    return
        indexes:replace-parameters($new-parameters)
};

declare function indexes:set-sortorder($current-sortorder, $current-sortby, $new-sortby) {
    if ($current-sortby eq $new-sortby) then
        indexes:toggle-sortorder($current-sortorder)
    else
        indexes:strip-param-from-param-string(indexes:replace-parameters(concat('sortby=', $new-sortby)), 'sortorder')
};

declare function indexes:set-sortorder($new-sortby) {
    indexes:set-sortorder($indexes:sortorder, $indexes:sortby, $new-sortby)
};

declare function indexes:sort-direction-indicator($sortby as xs:string) {
    if ($sortby eq $indexes:sortby) then
        if ($indexes:sortorder eq 'ascending') then
            ' ↓'
        else
            ' ↑'
    else ()
};

(:
    ====
    Helper functions for handling parameters
    ====
:)
declare function indexes:remove-parameter-names($parameter-names-to-remove) {
    let $current-parameter-names := request:get-parameter-names()
    let $remaining-parameters :=
        indexes:remove-parameter-names(
            for $current-parameter-name in $current-parameter-names
            return
                concat($current-parameter-name, '=', request:get-parameter( $current-parameter-name, () ))
            ,
            $parameter-names-to-remove
            )
    return
        if (exists($remaining-parameters)) then
            concat('?', string-join($remaining-parameters, '&'))
        else
            '?'
};

declare function indexes:remove-parameter-names($current-parameters, $parameter-names-to-remove) {
    for $current-parameter in $current-parameters
    return
        if (substring-before($current-parameter, '=') = $parameter-names-to-remove) then
            ()
        else
            $current-parameter
};

declare function indexes:remove-parameter-names-except($parameter-names-to-keep) {
    let $current-parameter-names := request:get-parameter-names()
    return
        indexes:remove-parameter-names($current-parameter-names[not(. = $parameter-names-to-keep)])
};

declare function indexes:replace-parameters($new-parameters) {
    let $current-parameter-names := request:get-parameter-names()
    let $current-parameters :=
        for $name in $current-parameter-names
        return concat($name, '=', request:get-parameter($name, ()))
    return
        indexes:replace-parameters($current-parameters, $new-parameters)
};

declare function indexes:replace-parameters($current-parameters, $new-parameters) {
    let $new-parameter-names := for $new-parameter in $new-parameters return substring-before($new-parameter, '=')
    let $remaining-parameters := indexes:remove-parameter-names($current-parameters, $new-parameter-names)
    let $result-parameters := for $param in ($remaining-parameters, $new-parameters) order by $param return $param
    return
        concat('?', string-join($result-parameters, '&'))
};

declare function indexes:strip-param-from-param-string($param-string, $param) {
    replace($param-string, concat('&?', $param, '=[^&]*?&?.*$'), '')
};

xquery version "1.0";

(:
    Module: Browse Indexes: See an overview of .xconf files stored in /db/system/config,
    and browse the associated index keys.
:)

module namespace indexes="http://exist-db.org/xquery/admin-interface/indexes";

declare namespace cc="http://exist-db.org/collection-config/1.0";

declare option exist:serialize "method=xhtml media-type=text/html omit-xml-declaration=no enforce-xhtml=yes";

(:
    Global variables - derived from URL parameters
:)
declare variable $indexes:start-value := request:get-parameter('start-value', '');
declare variable $indexes:callback := util:function(xs:QName("indexes:term-callback"), 2);
declare variable $indexes:max-number-returned := xs:integer(request:get-parameter('max', 100));
declare variable $indexes:index := request:get-parameter('index', '');
declare variable $indexes:sortby := request:get-parameter('sortby', 'term');
declare variable $indexes:sortorder := request:get-parameter('sortorder', 'ascending');
declare variable $indexes:node-name := request:get-parameter('node-name', '');
declare variable $indexes:match := request:get-parameter('match', '');
declare variable $indexes:collection := request:get-parameter('collection', '');
declare variable $indexes:node-set :=
    if ($indexes:node-name ne '' and $indexes:collection ne '') then
        indexes:get-nodeset-from-qname($indexes:collection, $indexes:node-name)
    else if ($indexes:match ne '' and $indexes:collection ne '') then
        indexes:get-nodeset-from-match($indexes:collection, $indexes:match)
    else
        ();
declare variable $indexes:qname :=
    if ($indexes:node-name ne '') then
        if (not(matches($indexes:node-name, 'xml:')) and contains($indexes:node-name, ':')) then
            QName(indexes:get-namespace-uri-from-node-name($indexes:node-name, $indexes:collection), $indexes:node-name)
        else
            xs:QName($indexes:node-name)
    else ();
declare variable $indexes:show-keys-by := request:get-parameter('show-keys-by', '');
declare variable $indexes:index-names :=

        <name>Index Types</name>
        <description>This is the list of known index types and their labels.</description>
        <items>
            <item>
                Lucene
                <value>lucene-index</value>
            </item>
            <item>
                NGram
                <value>ngram-index</value>
            </item>
            <item>
                Range
                <value>range-index</value>
            </item>
            <item>
                Legacy Fulltext
                <value>legacy-fulltext-index</value>
            </item>
        </items>
    ;

(:
    Main function: outputs the page.
:)
declare function indexes:main() {
    let $xconfs :=
        for $xconf in collection('/db/system/config/')/cc:collection
        order by util:collection-name($xconf)
        return $xconf
    return
        if (empty($xconfs)) then

Browse Indexes

No Index Configurations were found in the /db/system/config collection.
                    Consider installing eXist's example files or
                    documentation and then returning here
                    to browse the indexes.

        else if (empty($indexes:node-set)) then

            indexes:list-indexes($xconfs)

        else

            indexes:show-index-keys()
};

(:
    Lists indexes.
:)
declare function indexes:list-indexes($xconfs) {

Browse Indexes

This is an overview of the index definitions applied in the database,
            as well as the "index keys" (the actual items stored in the index).

Browsing {count($xconfs)} indexes:

        { indexes:xconf-to-table($xconfs) }

};

(:
    Transforms an index definition into an HTML table.
:)
declare function indexes:xconf-to-table($xconfs as node()*) as item()* {

{
        for $xconf at $count in $xconfs
        let $xconf-collection-name := util:collection-name($xconf)
        let $data-collection-name := substring-after(util:collection-name($xconf), '/db/system/config')
        order by $xconf-collection-name
        return

                {$count}. {$data-collection-name} {if (xmldb:collection-available($data-collection-name)) then () else ' (no data)'}
                    (View xconf file)

                        Item Indexed
                        Index
                        Instances
                        Show Index Keys By

                    {
                    for $entry in ( indexes:analyze-legacy-fulltext-indexes($xconf),
                        indexes:analyze-lucene-indexes($xconf),
                        indexes:analyze-range-indexes($xconf),
                        indexes:analyze-ngram-indexes($xconf) )
                    let $item := $entry/td[1]
                    let $index := $entry/td[2]
                    (: order by $index, $item :)
                    return $entry
                    }

    }

};

(:
    Shows the index keys on a given nodeset or QName
:)
declare function indexes:show-index-keys() {
    let $query-start-time := util:system-time()

    let $keys :=
        (: legacy fulltext index use the text:index-terms() function :)
        if ($indexes:index eq 'legacy-fulltext-index') then
            text:index-terms($indexes:node-set, $indexes:start-value, $indexes:callback, $indexes:max-number-returned)
        (: range indexes can use util:index-keys() without specifying the index :)
        else if ($indexes:index eq 'range-index') then
            if (util:index-type($indexes:node-set) eq 'xs:string') then
                util:index-keys($indexes:node-set, $indexes:start-value, $indexes:callback, $indexes:max-number-returned)
            else
                let $start-value :=
                    if (util:index-type($indexes:node-set) eq 'xs:double') then
                        if ($indexes:start-value castable as xs:double) then xs:double($indexes:start-value) else xs:double(0)
                    else if (util:index-type($indexes:node-set) eq 'xs:float') then
                        if ($indexes:start-value castable as xs:float) then xs:float($indexes:start-value) else xs:float(0)
                    else if (util:index-type($indexes:node-set) eq 'xs:boolean') then
                        if ($indexes:start-value castable as xs:boolean) then xs:boolean($indexes:start-value) else xs:boolean(0)
                    else if (util:index-type($indexes:node-set) eq 'xs:dateTime') then
                        if ($indexes:start-value castable as xs:dateTime) then xs:dateTime($indexes:start-value) else xs:dateTime('0001-01-01T00:00:00-00:00')
                    else if (util:index-type($indexes:node-set) eq 'xs:date') then
                        if ($indexes:start-value castable as xs:date) then xs:date($indexes:start-value) else xs:date('0001-01-01')
                    else
                        if ($indexes:start-value castable as xs:integer) then xs:integer($indexes:start-value)
                    else 0
                return util:index-keys($indexes:node-set, $start-value, $indexes:callback, $indexes:max-number-returned)
        (: all other indexes need to specify the index in the 5th parameter of util:index-keys() :)
        else
            if ($indexes:show-keys-by eq 'node') then
                util:index-keys($indexes:node-set, $indexes:start-value, $indexes:callback, $indexes:max-number-returned, $indexes:index)
            else
                util:index-keys-by-qname($indexes:qname, $indexes:start-value, $indexes:callback, $indexes:max-number-returned, $indexes:index)

    let $log := util:log("DEBUG", concat("INDEXES index type:    ", $indexes:index))
    let $log := util:log("DEBUG", concat("INDEXES qname     :    ", $indexes:qname))

    (:  Reminder for sorting:
           term = $key/td[1]
           frequency := xs:integer($key/td[2])
           documents := xs:integer($key/td[3])
           position := xs:integer($key/td[4])
    :)

    let $sorted-keys :=
        if ($indexes:sortby eq 'term') then
            if ($indexes:sortorder eq 'ascending') then
                for $key in $keys order by $key/td[1] ascending return $key
            else
                for $key in $keys order by $key/td[1] descending return $key
        else if ($indexes:sortby eq 'frequency') then
            if ($indexes:sortorder eq 'ascending') then
                for $key in $keys order by xs:integer($key/td[2]) ascending, $key/td[1] ascending return $key
            else
                for $key in $keys order by xs:integer($key/td[2]) descending, $key/td[1] ascending return $key
        else if ($indexes:sortby eq 'documents') then
            if ($indexes:sortorder eq 'ascending') then
                for $key in $keys order by xs:integer($key/td[3]) ascending, $key/td[1] ascending return $key
            else
                for $key in $keys order by xs:integer($key/td[3]) descending, $key/td[1] ascending return $key
        else if ($indexes:sortby eq 'position') then
            if ($indexes:sortorder eq 'ascending') then
                for $key in $keys order by xs:integer($key/td[4]) ascending return $key
            else
                for $key in $keys order by xs:integer($key/td[4]) descending return $key
        else $keys

    let $query-end-time := util:system-time()
    let $query-duration := ($query-end-time - $query-start-time) div xs:dayTimeDuration('PT1S')

    return

View Index Keys

Select a different index

{count($keys)} keys returned in {$query-duration}s

Keys for the {indexes:index-name-to-label($indexes:index)} index defined on "{string-join(($indexes:node-name, $indexes:match), '')}" in the {$indexes:collection} collection, by {$indexes:show-keys-by}.

            <form method="get" action="{indexes:remove-parameter-names('start-value')}">

                    Max number returned: <select name="max">{
                        for $number in (10, 100, 1000, 10000)
                        return
                            <option value="{$number}">{if ($number eq $indexes:max-number-returned) then attribute selected {'selected'} else ()}{$number}</option>
                    }</select>

                    Search for terms starting with: <input name="start-value" type="text" value="{$indexes:start-value}"/>
                    {if ($indexes:start-value ne '') then Clear search else ()}
                    {
                    for $param in request:get-parameter-names()[not(. = ('max', 'start-value'))]
                    return
                        <input type="hidden" name="{$param}" value="{request:get-parameter($param, '')}"/>
                    }

                    <input type="submit"/>

            </form>

{
                    for $column in ('term', 'frequency', 'documents', 'position')
                    return
                        {$column} {indexes:sort-direction-indicator($column)}
                }

                { $sorted-keys }

};

(:
    Helper function: Callback function called used in indexes:show-index-keys() for util:index-keys()
:)
declare function indexes:term-callback($term as xs:string, $data as xs:int+) as element() {

        {$term}
        {$data[1]}
        {$data[2]}
        {$data[3]}

};

(:
    Analyzes the Lucene indexes in an index definition
:)
declare function indexes:analyze-lucene-indexes($xconf) {
    let $index-label := indexes:index-name-to-label('lucene-index')
    let $lucene := $xconf/cc:index/cc:lucene
    return if (not($lucene) or not($lucene/cc:text)) then () else
        (
        (: TODO: complete report of default/other Lucene analyzers :)
        (:let $analyzers := $lucene/cc:analyzer
        return
            if ($analyzers) then
                (

Lucene Analyzers

                ,
                for $node in $analyzers
                return
                    if (not($node/@id)) then

default: {concat(' ', $node/@class/string())}

                    else

{$node/@id/string()}: {concat(' ', $node/@class/string())}

                )
            else ()
        ,:)
        let $texts := $lucene//cc:text
        return
            (
            for $text in $texts
            let $qname := if ($text/@qname) then $text/@qname/string() else ()
            let $match := if ($text/@match) then $text/@match/string() else ()
            let $analyzer := if ($text/@analyzer) then $text/@analyzer/string() else ()
            let $collection := substring-after(util:collection-name($text), '/db/system/config')
            let $nodeset := if ($qname) then indexes:get-nodeset-from-qname($collection, $qname) else indexes:get-nodeset-from-match($collection, $match)
            return

                        {if ($qname) then $qname else $match}
                        {if ($text/@boost) then concat(' (boost: ', $text/@boost/string(), ')') else ()}
                        {if ($text/cc:ignore) then (
, concat('(ignore: ', string-join(for $ignore in $text/cc:ignore return $ignore/@qname/string(), ', '), ')')) else ()}
                    {$index-label} {if ($qname) then ' QName' else ' Match'} {if ($analyzer) then concat(' (', $analyzer, ')') else ' (default analyzer)' (: TODO: complete report of default/other Lucene analyzers :)}
                    {count($nodeset)}
                    {
                        if (empty($nodeset)) then ()
                        else
                            (
                            QName
                            ,
                            ', '
                            ,
                            Node
                            )
                    }

            )
        )
};

(:
    Analyzes the legacy fulltext indexes in an index definition
:)
declare function indexes:analyze-legacy-fulltext-indexes($xconf) {
    let $collection := substring-after(util:collection-name($xconf), '/db/system/config')
    let $index := 'legacy-fulltext-index'
    let $index-label := indexes:index-name-to-label($index)
    let $fulltext := $xconf/cc:index/cc:fulltext
    let $creates := $fulltext/cc:create
    let $default-none := $fulltext/@default eq 'none'
    let $attributes-none := $fulltext/@attributes eq 'false'

    let $no-fulltext := if ( not($fulltext) or ($default-none and $attributes-none and not($creates)) ) then '(disabled)' else ()
    return
        if ($no-fulltext) then ()
        else if (not($default-none) and not($attributes-none)) then

                All Elements and Attributes!
                {$index-label}
                {count(collection($collection)//*)} elements and {count(collection($collection)//@*)} attributes
                (Too many to display)

(: is it feasible to display all qnames/nodes here? :)
        else (: if ($creates) then :)
            (
            for $create in $creates
            let $qname := $create/@qname/string()
            let $mixed := $create/@mixed/string()
            return

                    {$qname}
                    {$index-label} {if ($mixed) then '(mixed)' else ()}
                    {count(util:eval(concat('collection(', $collection, ')//', $qname)))}
                    Node

            ,
            let $only-elements-disabled := if ($fulltext/@default eq 'none' and $fulltext/@attributes ne 'no') then '(elements disabled)' else ()
            let $only-attribs-disabled := if ($fulltext/@default ne 'none' and $fulltext/@attributes eq 'no') then '(attributes disabled)' else ()
            return
            if ($only-elements-disabled) then

                    All Attributes!
                    {$index-label}
                    {count(collection($collection)//@*)} attributes
                    (Too many to display)

(: is it feasible to display all qnames/nodes here? :)
            else if ($only-attribs-disabled) then

                    All Elements!
                    {$index-label}
                    {count(collection($collection)//*)} elements
                    (Too many to display)

(: is it feasible to display all qnames/nodes here? :)
            else ()
            )
};

(:
    Analyzes the range indexes in an index definition
:)
declare function indexes:analyze-range-indexes($xconf) {
    let $index-label := indexes:index-name-to-label('range-index')
    let $ranges := $xconf/cc:index/cc:create
    return if (not($ranges)) then () else
        for $range in $ranges
        let $qname := $range/@qname/string()
        let $match := $range/@path/string()
        let $type := $range/@type/string()
        let $collection := substring-after(util:collection-name($range), '/db/system/config')
        let $nodeset := if ($qname) then indexes:get-nodeset-from-qname($collection, $qname) else indexes:get-nodeset-from-match($collection, $match)
        return

                {if ($qname) then $qname else $match}
                {$index-label} {if ($qname) then ' QName' else ' Path'} ({$type})
                {count($nodeset)}
                {
                    if (empty($nodeset)) then ()
                    else
                        Node
                }

};

(:
    Analyzes the NGram indexes in an index definition
:)
declare function indexes:analyze-ngram-indexes($xconf) {
    let $index-label := indexes:index-name-to-label('ngram-index')
    let $ngrams := $xconf/cc:index/cc:ngram
    return if (not($ngrams)) then () else
        for $ngram in $ngrams
        let $qname := $ngram/@qname/string()
        let $collection := substring-after(util:collection-name($ngram), '/db/system/config')
        let $nodeset := indexes:get-nodeset-from-qname($collection, $qname)
        return

                {$qname}
                {$index-label} QName
                {count($nodeset)}
                {
                    if (not(empty($nodeset))) then
                        (
                        QName,
                        ', '
                        ,
                        Node
                        )
                     else ()
                 }

};

(:
    Helper function: Returns a nodeset of instances of a node-name in a collection
:)
declare function indexes:get-nodeset-from-qname($collection as xs:string, $node-name as xs:string) as node()* {
    let $nodeset-expression :=
        concat(
            indexes:get-namespace-declaration-from-node-name($node-name, $collection)
            ,
            'collection("', $collection, '")//', $node-name
        )
    let $log := util:log("DEBUG", concat("INDEXES get-nodeset:          ", $nodeset-expression))
    return
        util:eval($nodeset-expression)
};

(:
    Helper function: Returns a nodeset of instances of a match expression in a collection
:)
declare function indexes:get-nodeset-from-match($collection as xs:string, $match as xs:string) as node()* {
    let $nodeset-expression :=
        concat(
            string-join(
                distinct-values(
                let $node-names := tokenize(replace($match, '//', '/'), '/')
                return
                    for $node-name in $node-names
                    return
                        indexes:get-namespace-declaration-from-node-name($node-name, $collection)
                ), ' ')
            ,
            'collection("', $collection, '")', $match, if (contains($match, '@')) then () else ()
        )
    return
        util:eval($nodeset-expression)
};

(:
    Helper function: Returns the index definition for a given collection
:)
declare function indexes:get-xconf($collection as xs:string) as document-node() {
    let $config-root := '/db/system/config'
    let $xconf-collection := concat($config-root, $collection)
    let $xconf-filename := xmldb:get-child-resources($xconf-collection)[ends-with(., '.xconf')]
    let $xconf := doc(concat($xconf-collection, '/', $xconf-filename))
    return $xconf
};

(:
    Helper function: Looks in the collection.xconf's collection and index elements for namespace URIs for a given node name
:)
declare function indexes:get-namespace-uri-from-node-name($node-name, $collection) {

    let $name := if (starts-with($node-name,'@')) then
                    substring-after( substring-before($node-name, ':'), '@' )
                else
                    substring-before($node-name, ':')

    let $xconf := indexes:get-xconf($collection)
    let $uri := (namespace-uri-for-prefix($name, $xconf/cc:collection), namespace-uri-for-prefix($name, $xconf//cc:index))
    return
        $uri
};

(:
    Helper function: Constructs a namespace declaration for use in util:eval()
:)
declare function indexes:get-namespace-declaration-from-node-name($node-name as xs:string, $collection as xs:string) as xs:string? {
    if (not(matches($node-name, 'xml:')) and contains($node-name, ':')) then

        let $name := if (starts-with($node-name,'@')) then
                        substring-after( substring-before($node-name, ':'), '@' )
                    else
                        substring-before($node-name, ':')

        let $uri := indexes:get-namespace-uri-from-node-name($node-name, $collection)
        return
            concat('declare namespace ', $name, '="', $uri, '"; ')
    else ()
};

(:
    Helper function: gets the label for a given index-name
:)
declare function indexes:index-name-to-label($index-name as xs:string) as xs:string {
    $indexes:index-names//item[value eq $index-name]/label/text()
};

(:
    ====
    Helper functions for modifying the sort order used in indexes:show-index-keys()
    ====
:)
declare function indexes:toggle-sortorder($current-sortorder) {
    indexes:toggle-sortorder($current-sortorder, ())
};

declare function indexes:toggle-sortorder($current-sortorder, $other-new-parameters) {
    let $neworder :=
        if ($current-sortorder eq 'ascending') then
            'sortorder=descending'
        else
            'sortorder=ascending'
    let $new-parameters := ($neworder, $other-new-parameters)
    return
        indexes:replace-parameters($new-parameters)
};

declare function indexes:set-sortorder($current-sortorder, $current-sortby, $new-sortby) {
    if ($current-sortby eq $new-sortby) then
        indexes:toggle-sortorder($current-sortorder)
    else
        indexes:strip-param-from-param-string(indexes:replace-parameters(concat('sortby=', $new-sortby)), 'sortorder')
};

declare function indexes:set-sortorder($new-sortby) {
    indexes:set-sortorder($indexes:sortorder, $indexes:sortby, $new-sortby)
};

declare function indexes:sort-direction-indicator($sortby as xs:string) {
    if ($sortby eq $indexes:sortby) then
        if ($indexes:sortorder eq 'ascending') then
            ' ↓'
        else
            ' ↑'
    else ()
};

(:
    ====
    Helper functions for handling parameters
    ====
:)
declare function indexes:remove-parameter-names($parameter-names-to-remove) {
    let $current-parameter-names := request:get-parameter-names()
    let $remaining-parameters :=
        indexes:remove-parameter-names(
            for $current-parameter-name in $current-parameter-names
            return
                concat($current-parameter-name, '=', request:get-parameter( $current-parameter-name, () ))
            ,
            $parameter-names-to-remove
            )
    return
        if (exists($remaining-parameters)) then
            concat('?', string-join($remaining-parameters, '&'))
        else
            '?'
};

declare function indexes:remove-parameter-names($current-parameters, $parameter-names-to-remove) {
    for $current-parameter in $current-parameters
    return
        if (substring-before($current-parameter, '=') = $parameter-names-to-remove) then
            ()
        else
            $current-parameter
};

declare function indexes:remove-parameter-names-except($parameter-names-to-keep) {
    let $current-parameter-names := request:get-parameter-names()
    return
        indexes:remove-parameter-names($current-parameter-names[not(. = $parameter-names-to-keep)])
};

declare function indexes:replace-parameters($new-parameters) {
    let $current-parameter-names := request:get-parameter-names()
    let $current-parameters :=
        for $name in $current-parameter-names
        return concat($name, '=', request:get-parameter($name, ()))
    return
        indexes:replace-parameters($current-parameters, $new-parameters)
};

declare function indexes:replace-parameters($current-parameters, $new-parameters) {
    let $new-parameter-names := for $new-parameter in $new-parameters return substring-before($new-parameter, '=')
    let $remaining-parameters := indexes:remove-parameter-names($current-parameters, $new-parameter-names)
    let $result-parameters := for $param in ($remaining-parameters, $new-parameters) order by $param return $param
    return
        concat('?', string-join($result-parameters, '&'))
};

declare function indexes:strip-param-from-param-string($param-string, $param) {
    replace($param-string, concat('&?', $param, '=[^&]*?&?.*$'), '')
};


Removed file/folder

Removed file/folder

<bib>
 {
  for $b in doc("http://bstore1.example.com/bib.xml")/bib/book
  where $b/publisher = "Addison-Wesley" and $b/@year > 1991
  return
    <book year="{ $b/@year }">
     { $b/title }
    </book>
 }
</bib>


Added mention of ZOSE0007.

Added mention of ZOSE0007.

xquery version "3.0";

(:
 : Copyright 2006-2009 The FLWOR Foundation.
 :
 : 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.
:)

(:~
 : This module provides functions to retrieve the current dateTime and to
 : parse dates and times.
 :
 : In contrast to the current-dateTime functions specified in
 : XQuery Functions and
 : Operators, the functions in this module are nondeterministic, that is,
 : they do not return the current dateTime from the dynamic context, but return
 : the actual value.
 :
 : Dates and times are parsed according to the format given by
 : strptime.
 : However, date and time values must be "complete."
 : For a date, the year and either month and day or day of the year must have
 : been parsed.
 : For a time, the hour must have been parsed.
 : (If either the minute, second, or timezone has not been parsed, they default
 : to 0.)
 : For a dateTime, the parsing requirements of both date and time must be met.
 :
 : When a locale is given,
 : it must be of the form {lang}[{sep}{country}[{encoding}]] where
 : {lang} is an ISO 639-1 2-letter or 639-2 3-letter language code,
 : {sep} is either '-' or '_',
 : {country} is an ISO 3166-1 2-letter country code,
 : and {encoding} is any string that begins with a '.'.
 : The {sep}, {country}, and {encoding} are optional;
 : {encoding} is always ignored.
 : Examples include: de, en-US, fr_CA, ru_RU.UTF-8.
 :
 : @author Matthias Brantner
 : @author Paul J. Lucas
 : @see http://www.w3.org/TR/xpath-functions/#context
 : @project XDM/atomic
 :
 :)
module namespace datetime = "http://www.zorba-xquery.com/modules/datetime";

declare namespace an = "http://www.zorba-xquery.com/annotations";
declare namespace zerr = "http://www.zorba-xquery.com/errors";

declare namespace ver = "http://www.zorba-xquery.com/options/versioning";
declare option ver:module-version "2.0";

(:~
 : Gets the current date value in Universal time.
 : Note that this function is not stable: it returns the value of the date when
 : the function is invoked.
 :
 : @return the non-stable date value
 :)
declare %an:nondeterministic function datetime:current-date()
  as xs:date external;

(:~
 : Gets the current dateTime value in Universal time.
 : Note that this function is not stable: it returns the value of the date and
 : time when the function is invoked.
 :
 : @return the non-stable datetime value
 :)
declare %an:nondeterministic function datetime:current-dateTime()
  as xs:dateTime external;

(:~
 : Return the current time value in Universal time.
 : Note that this function is not stable: it returns the value of the time when
 : the function is invoked.
 :
 : @return the non-stable time value
 :)
declare %an:nondeterministic function datetime:current-time()
  as xs:time external;

(:~
 : Parses a date from a string in the current locale.
 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @return Returns an xs:date.
 : @error zerr:ZDTP0001 if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002 if $input is insufficient for $format.
 : @error zerr:ZDTP0003 if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004 if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005 if the date is incomplete.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-date-uD-1.xq
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-date-uF-1.xq
 :)
declare function datetime:parse-date(
  $input as xs:string,
  $format as xs:string
) as xs:date external;

(:~
 : Parses a date from a string in the given locale.
 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @param $locale The locale to use.
 : @return Returns an xs:date.
 : @error zerr:ZDTP0001 if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002 if $input is insufficient for $format.
 : @error zerr:ZDTP0003 if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004 if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005 if the date is incomplete.
 : @error zerr:ZXQP0011 if $locale is in an invalid format.
 : @error zerr:ZXQP0012 if $locale is unknown.
 : @error zerr:ZOSE0007 if $locale is unsupported by the operating system.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-date-la-uD-1.xq
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-date-uA-uD-2.xq
 :)
declare function datetime:parse-date(
  $input as xs:string,
  $format as xs:string,
  $locale as xs:string
) as xs:date external;

(:~
 : Parses a dateTime from a string in the current locale.
 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @return Returns an xs:dateTime.
 : @error zerr:ZDTP0001 if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002 if $input is insufficient for $format.
 : @error zerr:ZDTP0003 if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004 if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005 if either the date or time is incomplete.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-dateTime-uFTZ-1.xq
 :)
declare function datetime:parse-dateTime(
  $input as xs:string,
  $format as xs:string
) as xs:dateTime external;

(:~
 : Parses a dateTime from a string in the given locale.
 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @param $locale The locale to use.
 : @return Returns an xs:dateTime.
 : @error zerr:ZDTP0001 if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002 if $input is insufficient for $format.
 : @error zerr:ZDTP0003 if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004 if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005 if either the date or time is incomplete.
 : @error zerr:ZXQP0011 if $locale is in an invalid format.
 : @error zerr:ZXQP0012 if $locale is unknown.
 : @error zerr:ZOSE0007 if $locale is unsupported by the operating system.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-dateTime-uAB-ld-uYTZ-1.xq
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-dateTime-uAB-ld-uYTZ-2.xq
 :)
declare function datetime:parse-dateTime(
  $input as xs:string,
  $format as xs:string,
  $locale as xs:string
) as xs:dateTime external;

(:~
 : Parses a time from a string in the current locale.
 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @return Returns an xs:time.
 : @error zerr:ZDTP0001 if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002 if $input is insufficient for $format.
 : @error zerr:ZDTP0003 if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004 if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005 if the hour has not been parsed.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-time-uH-1.xq
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-time-uIMS-1.xq
 :)
declare function datetime:parse-time(
  $input as xs:string,
  $format as xs:string
) as xs:time external;

(:~
 : Parses a time from a string in the given locale.
 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @param $locale The locale to use.
 : @return Returns an xs:time.
 : @error zerr:ZDTP0001 if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002 if $input is insufficient for $format.
 : @error zerr:ZDTP0003 if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004 if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005 if the hour has not been parsed.
 : @error zerr:ZXQP0011 if $locale is in an invalid format.
 : @error zerr:ZXQP0012 if $locale is unknown.
 : @error zerr:ZOSE0007 if $locale is unsupported by the operating system.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-time-lr-1.xq
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-time-lr-2.xq
 :)
declare function datetime:parse-time(
  $input as xs:string,
  $format as xs:string,
  $locale as xs:string
) as xs:time external;

(:~
 : Gets the the number of milliseconds since epoch.
 :
 : @return the said number of milliseconds.
 :)
declare %an:nondeterministic function datetime:timestamp()
  as xs:long external;

(:~
 : Gets the offset of the current timezone from Universal time.
 :
 : @return the offset in seconds with positive values being east of the prime
 : meridian.
 :)
declare %an:nondeterministic function datetime:utc-offset()
  as xs:long external;

(: vim:set et sw=2 ts=2: :)

xquery version "3.0";

(:
 : Copyright 2006-2009 The FLWOR Foundation.
 :
 : 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.
:)

(:~
 : This module provides functions to retrieve the current dateTime and to
 : parse dates and times.
 :
 : In contrast to the current-dateTime functions specified in
 : XQuery Functions and
 : Operators, the functions in this module are nondeterministic, that is,
 : they do not return the current dateTime from the dynamic context, but return
 : the actual value.
 :
 : Dates and times are parsed according to the format given by
 : strptime.
 : However, date and time values must be "complete."
 : For a date, the year and either month and day or day of the year must have
 : been parsed.
 : For a time, the hour must have been parsed.
 : (If either the minute, second, or timezone has not been parsed, they default
 : to 0.)
 : For a dateTime, the parsing requirements of both date and time must be met.
 :
 : When a locale is given,
 : it must be of the form {lang}[{sep}{country}[{encoding}]] where
 : {lang} is an ISO 639-1 2-letter or 639-2 3-letter language code,
 : {sep} is either '-' or '_',
 : {country} is an ISO 3166-1 2-letter country code,
 : and {encoding} is any string that begins with a '.'.
 : The {sep}, {country}, and {encoding} are optional;
 : {encoding} is always ignored.
 : Examples include: de, en-US, fr_CA, ru_RU.UTF-8.
 :
 : @author Matthias Brantner
 : @author Paul J. Lucas
 : @see http://www.w3.org/TR/xpath-functions/#context
 : @project XDM/atomic
 :
 :)
module namespace datetime = "http://www.zorba-xquery.com/modules/datetime";

declare namespace an = "http://www.zorba-xquery.com/annotations";
declare namespace zerr = "http://www.zorba-xquery.com/errors";

declare namespace ver = "http://www.zorba-xquery.com/options/versioning";
declare option ver:module-version "2.0";

(:~
 : Gets the current date value in Universal time.
 : Note that this function is not stable: it returns the value of the date when
 : the function is invoked.
 :
 : @return the non-stable date value
 :)
declare %an:nondeterministic function datetime:current-date()
  as xs:date external;

(:~
 : Gets the current dateTime value in Universal time.
 : Note that this function is not stable: it returns the value of the date and
 : time when the function is invoked.
 :
 : @return the non-stable datetime value
 :)
declare %an:nondeterministic function datetime:current-dateTime()
  as xs:dateTime external;

(:~
 : Return the current time value in Universal time.
 : Note that this function is not stable: it returns the value of the time when
 : the function is invoked.
 :
 : @return the non-stable time value
 :)
declare %an:nondeterministic function datetime:current-time()
  as xs:time external;

(:~
 : Parses a date from a string in the current locale.
 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @return Returns an xs:date.
 : @error zerr:ZDTP0001 if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002 if $input is insufficient for $format.
 : @error zerr:ZDTP0003 if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004 if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005 if the date is incomplete.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-date-uD-1.xq
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-date-uF-1.xq
 :)
declare function datetime:parse-date(
  $input as xs:string,
  $format as xs:string
) as xs:date external;

(:~
 : Parses a date from a string in the given locale.
 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @param $locale The locale to use.
 : @return Returns an xs:date.
 : @error zerr:ZDTP0001 if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002 if $input is insufficient for $format.
 : @error zerr:ZDTP0003 if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004 if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005 if the date is incomplete.
 : @error zerr:ZXQP0011 if $locale is in an invalid format.
 : @error zerr:ZXQP0012 if $locale is unknown.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-date-la-uD-1.xq
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-date-uA-uD-2.xq
 :)
declare function datetime:parse-date(
  $input as xs:string,
  $format as xs:string,
  $locale as xs:string
) as xs:date external;

(:~
 : Parses a dateTime from a string in the current locale.
 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @return Returns an xs:dateTime.
 : @error zerr:ZDTP0001 if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002 if $input is insufficient for $format.
 : @error zerr:ZDTP0003 if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004 if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005 if either the date or time is incomplete.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-dateTime-uFTZ-1.xq
 :)
declare function datetime:parse-dateTime(
  $input as xs:string,
  $format as xs:string
) as xs:dateTime external;

(:~
 : Parses a dateTime from a string in the given locale.
 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @param $locale The locale to use.
 : @return Returns an xs:dateTime.
 : @error zerr:ZDTP0001 if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002 if $input is insufficient for $format.
 : @error zerr:ZDTP0003 if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004 if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005 if either the date or time is incomplete.
 : @error zerr:ZXQP0011 if $locale is in an invalid format.
 : @error zerr:ZXQP0012 if $locale is unknown.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-dateTime-uAB-ld-uYTZ-1.xq
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-dateTime-uAB-ld-uYTZ-2.xq
 :)
declare function datetime:parse-dateTime(
  $input as xs:string,
  $format as xs:string,
  $locale as xs:string
) as xs:dateTime external;

(:~
 : Parses a time from a string in the current locale.
 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @return Returns an xs:time.
 : @error zerr:ZDTP0001 if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002 if $input is insufficient for $format.
 : @error zerr:ZDTP0003 if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004 if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005 if the hour has not been parsed.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-time-uH-1.xq
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-time-uIMS-1.xq
 :)
declare function datetime:parse-time(
  $input as xs:string,
  $format as xs:string
) as xs:time external;

(:~
 : Parses a time from a string in the given locale.
 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @param $locale The locale to use.
 : @return Returns an xs:time.
 : @error zerr:ZDTP0001 if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002 if $input is insufficient for $format.
 : @error zerr:ZDTP0003 if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004 if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005 if the hour has not been parsed.
 : @error zerr:ZXQP0011 if $locale is in an invalid format.
 : @error zerr:ZXQP0012 if $locale is unknown.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-time-lr-1.xq
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-time-lr-2.xq
 :)
declare function datetime:parse-time(
  $input as xs:string,
  $format as xs:string,
  $locale as xs:string
) as xs:time external;

(:~
 : Gets the the number of milliseconds since epoch.
 :
 : @return the said number of milliseconds.
 :)
declare %an:nondeterministic function datetime:timestamp()
  as xs:long external;

(:~
 : Gets the offset of the current timezone from Universal time.
 :
 : @return the offset in seconds with positive values being east of the prime
 : meridian.
 :)
declare %an:nondeterministic function datetime:utc-offset()
  as xs:long external;

(: vim:set et sw=2 ts=2: :)


All tests pass

All tests pass

xquery version "3.0";

(:~
 : Tests for μ-templates
 :)
module namespace test = 'http://xokomola.com/xquery/origami/μ/tests';

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

declare namespace h = 'http://www.w3.org/1999/xhtml';

declare %unit:test function test:xml()
{

    (:~
     : A string becomes a text node.
     :)
    unit:assert-equals(
        μ:xml('a'),
        text { 'a' }
    ),

    unit:assert-equals(
        μ:xml(('a','b','c')),
        (text { 'a' }, text { 'b'}, text { 'c' })
    ),

    (:~
     : A one item array creates an empty element without attributes.
     :)
    unit:assert-equals(
        μ:xml(['a']),

    ),

    (:~
     : A two item array creates an element with child nodes.
     :)
    unit:assert-equals(
        μ:xml(['a','hello']),
        hello
    ),

    unit:assert-equals(
        μ:xml(['a','hello', 'world']),
        helloworld
    ),

    (:~
     : A two item array with the second item being a map returns
     : an empty element with attributes.
     :)
    unit:assert-equals(
        μ:xml(['a',map { 'x': 10, 'b': 'y' }]),

    ),

    (:~
     : Or, without attributes if the map is empty.
     :)
    unit:assert-equals(
        μ:xml(['a',map { }]),

    ),

    (:~
     : A three item array returns an element with attributes
     : and child nodes.
     :)
    unit:assert-equals(
        μ:xml(['a',map { 'x': 10, 'b': 'y' }, 'hello']),
        hello
    ),

    (:~
     : Or without attributes.
     :)
    unit:assert-equals(
        μ:xml(['a',map { }, 'hello']),
        hello
    ),

    (:~
     : Or without child nodes.
     :)
    unit:assert-equals(
        μ:xml(['a',map { 'x': 10, 'b': 'y' }, ()]),

    ),

    (:~
     : Or an empty element.
     :)
    unit:assert-equals(
        μ:xml(['a',map { }, ()]),

    ),

    (:~
     : If an item is already an XML node than it is passed
     : unmodified.
     :)
    unit:assert-equals(
        μ:xml(),

    ),

    (:~
     : Element items may be nested.
     :)
    unit:assert-equals(
        μ:xml(['a', (['b'], ['c'])]),

            <c/>

    ),

    unit:assert-equals(
        μ:xml(['a', ['b', ['c']]]),

                <c/>

    ),

    unit:assert-equals(
        μ:xml(['a', ('b','c')]),
        bc
    ),

    unit:assert-equals(
        μ:xml(['a', ('b','c')]),
        { text { 'b' }, text { 'c' }}
    ),

    unit:assert-equals(
        μ:xml(['a', 'b', 'c']),
        bc
    ),

    unit:assert-equals(
        μ:xml(['a', (map {'x': 1}, (map {'y': 2 }, 'b', 'c'))]),
        bc
    ),

    (: with naughty attribute/map values :)
    unit:assert-equals(
        μ:xml(['a', (map {'x': 1}, (map {'y': (2,3) }, 'b', 'c'))]),
        bc
    ),

    (:~
     : Atomic values will be converted into text nodes.
     :)
    unit:assert-equals(
        μ:xml(['a', (10,'c')]),
        10c
    ),

    (:~
     : Mixed content.
     :)
    unit:assert-equals(
        μ:xml(['a', ('foo', ['b', 'bar', ['c'], 'baz'])]),
        foobar<c/>baz
    )

};

declare %unit:test function test:json()
{
    unit:assert-equals(
        parse-json(μ:json(['a'])),
        ['a']
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', ['b']])),
        ['a', ['b']]
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }])),
        ['a', map { 'x': 1 }]
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }, 'foo'])),
        ['a', map { 'x': 1 }, 'foo']
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }, 'foo', 'bar'])),
        ['a', map { 'x': 1 }, 'foo', 'bar']
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }, 'foo', ['b', 'bar'], 'baz'])),
        ['a', map { 'x': 1 }, 'foo', ['b', 'bar'], 'baz']
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }, ('foo', ['b', 'bar'], 'baz')])),
        ['a', map { 'x': 1 }, 'foo', ['b', 'bar'], 'baz']
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }, ('foo', (['b', 'bar'], 'baz'))])),
        ['a', map { 'x': 1 }, 'foo', ['b', 'bar'], 'baz']
    ),

    (: nodes will be converted to μ-nodes before serializing to JSON :)
    unit:assert-equals(
        parse-json(μ:json(['a', ])),
        ['a', ['b']]
    ),

    (: attribute nodes become string map entry values :)
    unit:assert-equals(
        parse-json(μ:json(['a', <c y="1">foo</c>, '!'])),
        ['a', ['b', ['c', map { 'y': '1' }, 'foo']], '!']
    )

};

declare %unit:test function test:xml-template()
{

    (:~
     : This is the simplest way to build a list.
     :)
    unit:assert-equals(
        μ:xml(['ul',
                for $i in 1 to 3
                return ['li', concat('item ', $i)] ]),

item 1

item 2

item 3

    ),

    (: μ:xml-template returns a function with arity one :)
    unit:assert-equals(
        μ:xml-template(['ul',
            function($x) {
                for $i in 1 to $x
                return ['li', concat('item ', $i)]
            }])(3),

item 1

item 2

item 3

    ),

    (:~
     : The function may produce XML nodes. This is identical
     : to the above but uses a literal element constructor
     : to construct the li elements.
     :)
    unit:assert-equals(
        μ:xml-template(['ul',
            function($x) {
                for $i in 1 to $x
                return element li { concat('item ', $i) }
            }
        ])(3),

item 1

item 2

item 3

    ),

    (:~
     : Produce a table. Multiple arguments have to be specified as a sequence
     : or an array.
     :)
    unit:assert-equals(
        μ:xml-template(['table',
            function($r,$c) {
                for $i in 1 to $r
                return
                    ['tr',
                        function($r,$c) {
                            for $j in 1 to $c
                            return
                                ['td', concat('item ',$i,',',$j)]
                        }]
            }
        ])([3,2]),

              item 1,1
              item 1,2

              item 2,1
              item 2,2

              item 3,1
              item 3,2

    )
};

declare %unit:test function test:mu()
{

    unit:assert-equals(
        μ:mu(<x/>),
        ['x']),

    unit:assert-equals(
        μ:mu((<x/>, <y/>)),
        (['x'], ['y'])),

    unit:assert-equals(
        μ:mu(<x>hello</x>),
        ['x', 'hello']),

    unit:assert-equals(
        μ:mu(<x><y/></x>),
        ['x', ['y']]),

    unit:assert-equals(
        μ:mu(<x a="10" b="y"/>),
        ['x', map { 'a': '10', 'b': 'y' }]),

    unit:assert-equals(
        μ:mu(<x a="10" b="y">hello</x>),
        ['x', map { 'a': '10', 'b': 'y' }, 'hello']),

    unit:assert-equals(
        μ:mu(<x a="10" b="y">hello world</x>),
        ['x', map { 'a': '10', 'b': 'y' }, 'hello ', ['b', 'world']]),

    unit:assert-equals(
        μ:mu(<x>world</x>),
        ['x', 'world'])

};

declare %unit:test function test:xhtml()
{

    (:~
     : EXPERIMENTAL:
     : This only works for namespaces that are also declared inside
     : the library module. It cannot be changed unilaterally by the user.
     :)
    unit:assert-equals(
        μ:xml(['h:html']),
        <h:html/>
    ),

    unit:assert-equals(
        μ:xml(['h:html', ['x']]),
        <h:html><x/></h:html>
    ),

    unit:assert-equals(
        μ:mu(<h:html><x/></h:html>),
        ['h:html', ['x']]
    )

};

xquery version "3.0";

(:~
 : Tests for μ-templates
 :)
module namespace test = 'http://xokomola.com/xquery/origami/μ/tests';

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

declare namespace h = 'http://www.w3.org/1999/xhtml';

declare %unit:test function test:xml()
{

    (:~
     : A string becomes a text node.
     :)
    unit:assert-equals(
        μ:xml('a'),
        text { 'a' }
    ),

    unit:assert-equals(
        μ:xml(('a','b','c')),
        (text { 'a' }, text { 'b'}, text { 'c' })
    ),

    (:~
     : A one item array creates an empty element without attributes.
     :)
    unit:assert-equals(
        μ:xml(['a']),

    ),

    (:~
     : A two item array creates an element with child nodes.
     :)
    unit:assert-equals(
        μ:xml(['a','hello']),
        hello
    ),

    unit:assert-equals(
        μ:xml(['a','hello', 'world']),
        helloworld
    ),

    (:~
     : A two item array with the second item being a map returns
     : an empty element with attributes.
     :)
    unit:assert-equals(
        μ:xml(['a',map { 'x': 10, 'b': 'y' }]),

    ),

    (:~
     : Or, without attributes if the map is empty.
     :)
    unit:assert-equals(
        μ:xml(['a',map { }]),

    ),

    (:~
     : A three item array returns an element with attributes
     : and child nodes.
     :)
    unit:assert-equals(
        μ:xml(['a',map { 'x': 10, 'b': 'y' }, 'hello']),
        hello
    ),

    (:~
     : Or without attributes.
     :)
    unit:assert-equals(
        μ:xml(['a',map { }, 'hello']),
        hello
    ),

    (:~
     : Or without child nodes.
     :)
    unit:assert-equals(
        μ:xml(['a',map { 'x': 10, 'b': 'y' }, ()]),

    ),

    (:~
     : Or an empty element.
     :)
    unit:assert-equals(
        μ:xml(['a',map { }, ()]),

    ),

    (:~
     : If an item is already an XML node than it is passed
     : unmodified.
     :)
    unit:assert-equals(
        μ:xml(),

    ),

    (:~
     : Element items may be nested.
     :)
    unit:assert-equals(
        μ:xml(['a', (['b'], ['c'])]),

            <c/>

    ),

    unit:assert-equals(
        μ:xml(['a', ['b', ['c']]]),

                <c/>

    ),

    unit:assert-equals(
        μ:xml(['a', ('b','c')]),
        bc
    ),

    unit:assert-equals(
        μ:xml(['a', ('b','c')]),
        { text { 'b' }, text { 'c' }}
    ),

    unit:assert-equals(
        μ:xml(['a', 'b', 'c']),
        bc
    ),

    unit:assert-equals(
        μ:xml(['a', (map {'x': 1}, (map {'y': 2 }, 'b', 'c'))]),
        bc
    ),

    (: with naughty attribute/map values :)
    unit:assert-equals(
        μ:xml(['a', (map {'x': 1}, (map {'y': (2,3) }, 'b', 'c'))]),
        bc
    ),

    (:~
     : Atomic values will be converted into text nodes.
     :)
    unit:assert-equals(
        μ:xml(['a', (10,'c')]),
        10c
    ),

    (:~
     : Mixed content.
     :)
    unit:assert-equals(
        μ:xml(['a', ('foo', ['b', 'bar', ['c'], 'baz'])]),
        foobar<c/>baz
    )

};

declare %unit:test function test:json()
{
    unit:assert-equals(
        parse-json(μ:json(['a'])),
        ['a']
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', ['b']])),
        ['a', ['b']]
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }])),
        ['a', map { 'x': 1 }]
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }, 'foo'])),
        ['a', map { 'x': 1 }, 'foo']
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }, 'foo', 'bar'])),
        ['a', map { 'x': 1 }, 'foo', 'bar']
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }, 'foo', ['b', 'bar'], 'baz'])),
        ['a', map { 'x': 1 }, 'foo', ['b', 'bar'], 'baz']
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }, ('foo', ['b', 'bar'], 'baz')])),
        ['a', map { 'x': 1 }, 'foo', ['b', 'bar'], 'baz']
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }, ('foo', (['b', 'bar'], 'baz'))])),
        ['a', map { 'x': 1 }, 'foo', ['b', 'bar'], 'baz']
    ),

    (: nodes will be converted to μ-nodes before serializing to JSON :)
    unit:assert-equals(
        parse-json(μ:json(['a', ])),
        ['a', ['b']]
    ),

    (: attribute nodes become string map entry values :)
    unit:assert-equals(
        parse-json(μ:json(['a', <c y="1">foo</c>, '!'])),
        ['a', ['b', ['c', map { 'y': '1' }, 'foo']], '!']
    )

};

declare %unit:test function test:do-xml()
{

    (:~
     : This is the simplest way to build a list.
     :)
    unit:assert-equals(
        μ:xml(['ul',
                for $i in 1 to 3
                return ['li', concat('item ', $i)] ]),

item 1

item 2

item 3

    ),

    unit:assert-equals(
        μ:xml-template(['ul',
            function($x) {
                for $i in 1 to $x
                return ['li', concat('item ', $i)]
            }])(3),

item 1

item 2

item 3

    ),

    (:~
     : The function may produce XML nodes. This is identical
     : to the above.
     :)
    unit:assert-equals(
        μ:xml-template(['ul',
            function($x) {
                for $i in 1 to $x
                return element li { concat('item ', $i) }
            }
        ])(3),

item 1

item 2

item 3

    ),

    (:~
     : Produce a table.
     :)
    unit:assert-equals(
        μ:xml-template(['table',
            function($r,$c) {
                for $i in 1 to $r
                return
                    ['tr',
                        function($r,$c) {
                            for $j in 1 to $c
                            return
                                ['td', concat('item ',$i,',',$j)]
                        }]
            }
        ])((3,2)),

              item 1,1
              item 1,2

              item 2,1
              item 2,2

              item 3,1
              item 3,2

    )
};

declare %unit:test function test:mu()
{

    unit:assert-equals(
        μ:mu(<x/>),
        ['x']),

    unit:assert-equals(
        μ:mu((<x/>, <y/>)),
        (['x'], ['y'])),

    unit:assert-equals(
        μ:mu(<x>hello</x>),
        ['x', 'hello']),

    unit:assert-equals(
        μ:mu(<x><y/></x>),
        ['x', ['y']]),

    unit:assert-equals(
        μ:mu(<x a="10" b="y"/>),
        ['x', map { 'a': '10', 'b': 'y' }]),

    unit:assert-equals(
        μ:mu(<x a="10" b="y">hello</x>),
        ['x', map { 'a': '10', 'b': 'y' }, 'hello']),

    unit:assert-equals(
        μ:mu(<x a="10" b="y">hello world</x>),
        ['x', map { 'a': '10', 'b': 'y' }, 'hello ', ['b', 'world']]),

    unit:assert-equals(
        μ:mu(<x>world</x>),
        ['x', 'world'])

};

declare %unit:test function test:xhtml()
{

    (:~
     : EXPERIMENTAL:
     : This only works for namespaces that are also declared inside
     : the library module. It cannot be changed unilaterally by the user.
     :)
    unit:assert-equals(
        μ:xml(['h:html']),
        <h:html/>
    ),

    unit:assert-equals(
        μ:xml(['h:html', ['x']]),
        <h:html><x/></h:html>
    ),

    unit:assert-equals(
        μ:mu(<h:html><x/></h:html>),
        ['h:html', ['x']]
    )

};