ode-tools, timeline chart, now displays the entity charted

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

declare namespace dc = "http://purl.org/dc/elements/1.1/";
declare namespace pm = "http://www.politicalmashup.nl";
declare namespace pmx = "http://www.politicalmashup.nl/extra";
declare namespace folia = "http://ilk.uvt.nl/FoLiA";
declare namespace local = "local";

import module namespace datetime="http://exist-db.org/xquery/datetime";

import module namespace settings="http://politicalmashup.nl/modules/settings" at '/db/apps/modules/settings.xqm';
import module namespace export="http://politicalmashup.nl/modules/export";
import module namespace functx="http://www.functx.com";

declare function local:select-collection($request) {
  if ($request/@collection) then collection(concat($settings:data-root,'/',$request/@collection))
  else ()
};

declare function local:summarise-entity-names($entity-names as xs:string*) as xs:string {
  let $collapsed := for $en in $entity-names
                    let $name := xs:string($en)
                    group by $name
                    return <en n="{$name}" c="{count($en)}"/>
(:                    return concat($name,' (',count($en),')'):)
  let $strings := for $en in $collapsed order by xs:decimal($en/@c) descending return concat($en/@n,' (',$en/@c,')')
  return string-join($strings,', ')
};

declare function local:documents-per-month($collection, $request as element(request)) {

  let $wiki-link := local:fix-wikilink-input($request)

  let $document-links := $collection//dc:relation/pm:link[. eq $wiki-link]

  let $link-docs := for $dl in $document-links return root($dl)//meta

  let $dates := for $d in $link-docs//dc:date order by $d return $d

  let $distinct-dates := distinct-values($dates)

  let $first-date := $dates[1]
  let $last-date := $dates[last()]

  let $headers := (
    export:xml-util-description(concat('Entity graph for: ',$wiki-link)),
    export:xml-util-description(concat('From ',$first-date,' until ',$last-date)),
    export:xml-util-headers( ('date','#doc','#occ') )
    )

  (: Generate date/month list. :)
  let $first-year := xs:integer(substring($first-date,1,4))
  let $last-year := xs:integer(substring($last-date,1,4))
  let $date-months :=
    for $year in ($first-year to $last-year)
    return
      for $month in (1 to 12)
      let $m := if ($month le 9) then concat('0',xs:string($month)) else xs:string($month)
      return
        concat(xs:string($year),'-',$m)

  let $items :=
    for $dm in $date-months
    let $docs := $link-docs[substring(.//dc:date,1,7) eq $dm]
    let $occ := sum($docs//dc:relation/pm:link[. eq $wiki-link]/@pmx:entity-occurence)
    return
      export:xml-row(
        (
        export:xml-item($dm),
        export:xml-item(count($docs)),
        export:xml-item($occ)
        )
      )

  return export:xml-output( ($headers, $items) )
};

declare function local:documents-per-month-efficient($collection, $request as element(request)) {

  let $wiki-link := local:fix-wikilink-input($request)

  let $document-containers :=
    for $link in $collection//dc:relation/pm:link[. eq $wiki-link]
    let $date := xs:string(root($link)//dc:date)
    where $date ne '' (: ode Amsterdam data sometimes does not have a date, filter these.. :)
    return
      <doc date="{$date}" date-month="{substring($date,1,7)}">
      {$link}
      </doc>

  let $docs :=
    for $doc in $document-containers
    let $date-month := $doc/@date-month
    group by $date-month
    return
      <doc date-month="{$date-month}" cnt-doc="{count($doc)}" cnt-occ="{sum($doc//pm:link/@pmx:entity-occurence)}"/>

  let $date-months := for $dm in $document-containers/@date-month order by $dm return $dm
  let $first-date := $date-months[1]
  let $last-date := $date-months[last()]

  (: Generate date/month list. :)
  let $date-months :=
    if ($first-date ne '' and $last-date ne '') then
    let $first-year := xs:integer(substring($first-date,1,4))
    let $last-year := xs:integer(substring($last-date,1,4))
    return
      for $year in ($first-year to $last-year)
      return
        for $month in (1 to 12)
        let $m := if ($month le 9) then concat('0',xs:string($month)) else xs:string($month)
        return
          concat(xs:string($year),'-',$m)
    else ()

  let $headers := (
    export:xml-util-description(concat('Entity graph for: ',$wiki-link)),
    export:xml-util-description(concat('From ',$first-date,' until ',$last-date)),
    export:xml-util-headers( ('date','#doc','#occ','entity search link') )
    )

  let $items :=
    for $dm in $date-months
    let $dm-doc := $docs[@date-month eq $dm]
    return
      export:xml-row(
        (
        export:xml-item($dm),
        export:xml-item(if ($dm-doc) then $dm-doc/@cnt-doc else 0),
        export:xml-item(if ($dm-doc) then $dm-doc/@cnt-occ else 0),
        export:xml-item(concat('entity-search.xq?entity=',$request/@entity,'&collection=',$request/@collection,'&month=',$dm), <options link="true"/>)
        )
      )

  return export:xml-output( ($headers, $items) )
};

declare function local:documents-per-year($collection, $request as element(request)) {

  let $wiki-link := local:fix-wikilink-input($request)

  let $document-links := $collection//dc:relation/pm:link[. eq $wiki-link]

  let $link-docs := for $dl in $document-links return root($dl)//meta

  let $dates := for $d in $link-docs//dc:date order by $d return $d

  let $distinct-dates := distinct-values($dates)

  let $first-date := $dates[1]
  let $last-date := $dates[last()]

  let $headers := (
    export:xml-util-description(concat('Entity graph for: ',$wiki-link)),
    export:xml-util-description(concat('From ',$first-date,' until ',$last-date)),
    export:xml-util-headers( ('date','#doc','#occ') )
    )

  (: Generate date/month list. :)
  let $first-year := xs:integer(substring($first-date,1,4))
  let $last-year := xs:integer(substring($last-date,1,4))
  let $date-months :=
    for $year in ($first-year to $last-year)
    return xs:string($year)

  let $items :=
    for $dm in $date-months
    let $docs := $link-docs[substring(.//dc:date,1,4) eq $dm]
    let $occ := sum($docs//dc:relation/pm:link[. eq $wiki-link]/@pmx:entity-occurence)
    return
      export:xml-row(
        (
        export:xml-item($dm),
        export:xml-item(count($docs)),
        export:xml-item($occ)
        )
      )

  return export:xml-output( ($headers, $items) )
};

declare function local:documents-per-day($collection, $request as element(request)) {

  let $wiki-link := local:fix-wikilink-input($request)

  let $document-links := $collection//dc:relation/pm:link[. eq $wiki-link]

  let $link-docs := for $dl in $document-links return root($dl)//meta

  let $dates := for $d in $link-docs//dc:date order by $d return $d

  let $distinct-dates := distinct-values($dates)

  (: Let's add the days before and after the actual dates, which will automatically get 0 docs/occ. :)
  let $distinct-dates :=
    for $d in $distinct-dates
    let $xsd := xs:date($d)
    let $day-before := $xsd - xs:dayTimeDuration("P1D")
    let $day-after := $xsd + xs:dayTimeDuration("P1D")
    return ($day-before,$xsd,$day-after)

  let $distinct-dates := distinct-values($distinct-dates)

  let $headers := (
    export:xml-util-description(concat('Entity graph for: ',$wiki-link)),
    export:xml-util-headers( ('date','#doc','#occ') )
    )

  let $items :=
    for $date in $distinct-dates
    let $docs := $link-docs[.//dc:date eq $date]
    let $occ := sum($docs//dc:relation/pm:link[. eq $wiki-link]/@pmx:entity-occurence)
    return
      export:xml-row(
        (
        export:xml-item($date),
        export:xml-item(count($docs)),
        export:xml-item($occ)
        )
      )

  return export:xml-output( ($headers, $items) )
};

(: Escape input entity query, because xml (and index!) contains escaped strings. :)
declare function local:fix-wikilink-input($request) {
  (: Cut off the escaped part after the wiki link, then unescape the entity (in case input is actually escaped already), and escape the string, then combine again. :)
  concat(
    substring-before($request/@entity,'/wiki/'), '/wiki/',
    replace(
      encode-for-uri(
        util:unescape-uri(substring-after($request/@entity,'/wiki/'),'UTF-8')
      ), '%2F', '/'
    )
  )
};

declare function local:output-html($parts as element()*, $data, $request as element(request), $title as xs:string, $style as xs:string) as element() {

      {if ($title ne '') then <title>{$title}</title> else ()}
      {export:html-css()}
      {if ($style ne '') then  else ()}
      {local:chart-header($data, $request)}

      {$parts}

};

declare function local:chart-line($xml-output) {
  for $line in $xml-output/*
  let $date-date := replace($line/item[1]/@string,'-',',')
  return
    if ($line[self::head]) then ()
    else concat("['",$line/item[1]/@string,"',",$line/item[2]/@string,",",$line/item[3]/@string,"],
")
    (:else concat("[new Date(",$date-date,"),",$line/item[2]/@string,",",$line/item[3]/@string,"],
"):)
};

declare function local:chart-container() {

};

declare function local:chart-header($data as xs:string*, $request as element(request)) {
  let $start := 'google.load("visualization", "1", {packages:["corechart"]});
      google.setOnLoadCallback(drawChart);
      function drawChart() {
        var data = google.visualization.arrayToDataTable([
          ["Year-month", "#documents", "#occurences"],'

   let $end := concat(']);
        var options = {
          title: "Entity occurence: ',$request/@entity,'"
        };

        var chart = new google.visualization.LineChart(document.getElementById("chart_div"));

        // The select handler. Calls the getSelection() method
        function selectHandler() {
          var selectedItem = chart.getSelection()[0];
          if (selectedItem) {
            //var value = data.getValue(selectedItem.row, selectedItem.column);
            var search_url = entity_url("',$request/@entity,'","',$request/@collection,'",data.getValue(selectedItem.row, 0))
            window.location = search_url;
          }
        }

        google.visualization.events.addListener(chart, "select", selectHandler);

        chart.draw(data, options);
      }')

   return
    (,
    ,
    )
};

let $accepted-collections := string-join(export:build-collection-tree(true()),',')

let $count-queries := 'entities,documents'

let $request := export:request-parameters( (<view default="table" accept="csv,table,xml"/>,
                                            (:<count accept="{$count-queries}"/>,:)
                                            <entity/>,
                                            <collection accept="{$accepted-collections}"/>) )

let $options := export:options( (
                                  (:<count explanation="choose example query" select="{$count-queries}"/>,:)
                                  <view explanation="view output as html table or plain text csv" select="csv,table"/>,
                                  <entity explanation="entity as wikilink to search for"/>,
                                  <collection explanation="available leaf collections" select="{$accepted-collections}"/>,
                                  <entity-escaped value="{local:fix-wikilink-input($request)}" explanation="escaped wiki link used for querying"/>
                                ),
                                $request)

let $collection := local:select-collection($request)

(:let $xml-output := if ($request/@count eq 'entities') then local:entities($collection,$request)
                   else if ($request/@count eq 'documents') then local:documents($collection,$request)
                   else ():)
(:let $xml-output := local:documents-per-month($collection,$request):)
let $xml-output := local:documents-per-month-efficient($collection,$request)
(:let $xml-output := local:documents-per-year($collection,$request):)
(:let $xml-output := local:documents-per-day($collection,$request):)

let $introduction-html :=

Below a timeline is shown for a previously detected (pre-computed) Wikipedia entity link.
         Data is shown per month, with both the number of documents, and total number of mentions within these documents.

Clicking the chart on a specific point will link to a search for the actual documents.

      {local:chart-container()}

let $search-form := export:html-util-generate-search-form($options, $request)

(:  :let $output := if ($request/@view eq 'table') then ($introduction-html, $search-form, export:html-output($xml-output)) :)
let $output := if ($request/@view eq 'table') then ($introduction-html, $search-form)
               else if ($request/@view eq 'csv') then export:csv-output($xml-output)
               else if ($request/@view eq 'xml') then $xml-output
               else ()

let $script-data := local:chart-line($xml-output)

(:let $output := export:output($request/@view, $output, 'ODE-II FoLiA Entity Search'):)
let $output := local:output-html($output, $script-data, $request, 'ODE-II FoLiA Entity Search', '')

let $serialization := export:set-serialization( if ($request/@view eq 'table') then 'html' else if ($request/@view eq 'csv') then 'text' else 'xml' )

return $output

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

declare namespace dc = "http://purl.org/dc/elements/1.1/";
declare namespace pm = "http://www.politicalmashup.nl";
declare namespace pmx = "http://www.politicalmashup.nl/extra";
declare namespace folia = "http://ilk.uvt.nl/FoLiA";
declare namespace local = "local";

import module namespace datetime="http://exist-db.org/xquery/datetime";

import module namespace settings="http://politicalmashup.nl/modules/settings" at '/db/apps/modules/settings.xqm';
import module namespace export="http://politicalmashup.nl/modules/export";
import module namespace functx="http://www.functx.com";

declare function local:select-collection($request) {
  if ($request/@collection) then collection(concat($settings:data-root,'/',$request/@collection))
  else ()
};

declare function local:summarise-entity-names($entity-names as xs:string*) as xs:string {
  let $collapsed := for $en in $entity-names
                    let $name := xs:string($en)
                    group by $name
                    return <en n="{$name}" c="{count($en)}"/>
(:                    return concat($name,' (',count($en),')'):)
  let $strings := for $en in $collapsed order by xs:decimal($en/@c) descending return concat($en/@n,' (',$en/@c,')')
  return string-join($strings,', ')
};

declare function local:documents-per-month($collection, $request as element(request)) {

  let $wiki-link := local:fix-wikilink-input($request)

  let $document-links := $collection//dc:relation/pm:link[. eq $wiki-link]

  let $link-docs := for $dl in $document-links return root($dl)//meta

  let $dates := for $d in $link-docs//dc:date order by $d return $d

  let $distinct-dates := distinct-values($dates)

  let $first-date := $dates[1]
  let $last-date := $dates[last()]

  let $headers := (
    export:xml-util-description(concat('Entity graph for: ',$wiki-link)),
    export:xml-util-description(concat('From ',$first-date,' until ',$last-date)),
    export:xml-util-headers( ('date','#doc','#occ') )
    )

  (: Generate date/month list. :)
  let $first-year := xs:integer(substring($first-date,1,4))
  let $last-year := xs:integer(substring($last-date,1,4))
  let $date-months :=
    for $year in ($first-year to $last-year)
    return
      for $month in (1 to 12)
      let $m := if ($month le 9) then concat('0',xs:string($month)) else xs:string($month)
      return
        concat(xs:string($year),'-',$m)

  let $items :=
    for $dm in $date-months
    let $docs := $link-docs[substring(.//dc:date,1,7) eq $dm]
    let $occ := sum($docs//dc:relation/pm:link[. eq $wiki-link]/@pmx:entity-occurence)
    return
      export:xml-row(
        (
        export:xml-item($dm),
        export:xml-item(count($docs)),
        export:xml-item($occ)
        )
      )

  return export:xml-output( ($headers, $items) )
};

declare function local:documents-per-month-efficient($collection, $request as element(request)) {

  let $wiki-link := local:fix-wikilink-input($request)

  let $document-containers :=
    for $link in $collection//dc:relation/pm:link[. eq $wiki-link]
    let $date := xs:string(root($link)//dc:date)
    where $date ne '' (: ode Amsterdam data sometimes does not have a date, filter these.. :)
    return
      <doc date="{$date}" date-month="{substring($date,1,7)}">
      {$link}
      </doc>

  let $docs :=
    for $doc in $document-containers
    let $date-month := $doc/@date-month
    group by $date-month
    return
      <doc date-month="{$date-month}" cnt-doc="{count($doc)}" cnt-occ="{sum($doc//pm:link/@pmx:entity-occurence)}"/>

  let $date-months := for $dm in $document-containers/@date-month order by $dm return $dm
  let $first-date := $date-months[1]
  let $last-date := $date-months[last()]

  (: Generate date/month list. :)
  let $date-months :=
    if ($first-date ne '' and $last-date ne '') then
    let $first-year := xs:integer(substring($first-date,1,4))
    let $last-year := xs:integer(substring($last-date,1,4))
    return
      for $year in ($first-year to $last-year)
      return
        for $month in (1 to 12)
        let $m := if ($month le 9) then concat('0',xs:string($month)) else xs:string($month)
        return
          concat(xs:string($year),'-',$m)
    else ()

  let $headers := (
    export:xml-util-description(concat('Entity graph for: ',$wiki-link)),
    export:xml-util-description(concat('From ',$first-date,' until ',$last-date)),
    export:xml-util-headers( ('date','#doc','#occ','entity search link') )
    )

  let $items :=
    for $dm in $date-months
    let $dm-doc := $docs[@date-month eq $dm]
    return
      export:xml-row(
        (
        export:xml-item($dm),
        export:xml-item(if ($dm-doc) then $dm-doc/@cnt-doc else 0),
        export:xml-item(if ($dm-doc) then $dm-doc/@cnt-occ else 0),
        export:xml-item(concat('entity-search.xq?entity=',$request/@entity,'&collection=',$request/@collection,'&month=',$dm), <options link="true"/>)
        )
      )

  return export:xml-output( ($headers, $items) )
};

declare function local:documents-per-year($collection, $request as element(request)) {

  let $wiki-link := local:fix-wikilink-input($request)

  let $document-links := $collection//dc:relation/pm:link[. eq $wiki-link]

  let $link-docs := for $dl in $document-links return root($dl)//meta

  let $dates := for $d in $link-docs//dc:date order by $d return $d

  let $distinct-dates := distinct-values($dates)

  let $first-date := $dates[1]
  let $last-date := $dates[last()]

  let $headers := (
    export:xml-util-description(concat('Entity graph for: ',$wiki-link)),
    export:xml-util-description(concat('From ',$first-date,' until ',$last-date)),
    export:xml-util-headers( ('date','#doc','#occ') )
    )

  (: Generate date/month list. :)
  let $first-year := xs:integer(substring($first-date,1,4))
  let $last-year := xs:integer(substring($last-date,1,4))
  let $date-months :=
    for $year in ($first-year to $last-year)
    return xs:string($year)

  let $items :=
    for $dm in $date-months
    let $docs := $link-docs[substring(.//dc:date,1,4) eq $dm]
    let $occ := sum($docs//dc:relation/pm:link[. eq $wiki-link]/@pmx:entity-occurence)
    return
      export:xml-row(
        (
        export:xml-item($dm),
        export:xml-item(count($docs)),
        export:xml-item($occ)
        )
      )

  return export:xml-output( ($headers, $items) )
};

declare function local:documents-per-day($collection, $request as element(request)) {

  let $wiki-link := local:fix-wikilink-input($request)

  let $document-links := $collection//dc:relation/pm:link[. eq $wiki-link]

  let $link-docs := for $dl in $document-links return root($dl)//meta

  let $dates := for $d in $link-docs//dc:date order by $d return $d

  let $distinct-dates := distinct-values($dates)

  (: Let's add the days before and after the actual dates, which will automatically get 0 docs/occ. :)
  let $distinct-dates :=
    for $d in $distinct-dates
    let $xsd := xs:date($d)
    let $day-before := $xsd - xs:dayTimeDuration("P1D")
    let $day-after := $xsd + xs:dayTimeDuration("P1D")
    return ($day-before,$xsd,$day-after)

  let $distinct-dates := distinct-values($distinct-dates)

  let $headers := (
    export:xml-util-description(concat('Entity graph for: ',$wiki-link)),
    export:xml-util-headers( ('date','#doc','#occ') )
    )

  let $items :=
    for $date in $distinct-dates
    let $docs := $link-docs[.//dc:date eq $date]
    let $occ := sum($docs//dc:relation/pm:link[. eq $wiki-link]/@pmx:entity-occurence)
    return
      export:xml-row(
        (
        export:xml-item($date),
        export:xml-item(count($docs)),
        export:xml-item($occ)
        )
      )

  return export:xml-output( ($headers, $items) )
};

(: Escape input entity query, because xml (and index!) contains escaped strings. :)
declare function local:fix-wikilink-input($request) {
  (: Cut off the escaped part after the wiki link, then unescape the entity (in case input is actually escaped already), and escape the string, then combine again. :)
  concat(
    substring-before($request/@entity,'/wiki/'), '/wiki/',
    replace(
      encode-for-uri(
        util:unescape-uri(substring-after($request/@entity,'/wiki/'),'UTF-8')
      ), '%2F', '/'
    )
  )
};

declare function local:output-html($parts as element()*, $data, $request as element(request), $title as xs:string, $style as xs:string) as element() {

      {if ($title ne '') then <title>{$title}</title> else ()}
      {export:html-css()}
      {if ($style ne '') then  else ()}
      {local:chart-header($data, $request)}

      {$parts}

};

declare function local:chart-line($xml-output) {
  for $line in $xml-output/*
  let $date-date := replace($line/item[1]/@string,'-',',')
  return
    if ($line[self::head]) then ()
    else concat("['",$line/item[1]/@string,"',",$line/item[2]/@string,",",$line/item[3]/@string,"],
")
    (:else concat("[new Date(",$date-date,"),",$line/item[2]/@string,",",$line/item[3]/@string,"],
"):)
};

declare function local:chart-container() {

};

declare function local:chart-header($data as xs:string*, $request as element(request)) {
  let $start := 'google.load("visualization", "1", {packages:["corechart"]});
      google.setOnLoadCallback(drawChart);
      function drawChart() {
        var data = google.visualization.arrayToDataTable([
          ["Year-month", "#documents", "#occurences"],'

   let $end := concat(']);
        var options = {
          title: "Entity occurence"
        };

        var chart = new google.visualization.LineChart(document.getElementById("chart_div"));

        // The select handler. Calls the getSelection() method
        function selectHandler() {
          var selectedItem = chart.getSelection()[0];
          if (selectedItem) {
            //var value = data.getValue(selectedItem.row, selectedItem.column);
            var search_url = entity_url("',$request/@entity,'","',$request/@collection,'",data.getValue(selectedItem.row, 0))
            window.location = search_url;
          }
        }

        google.visualization.events.addListener(chart, "select", selectHandler);

        chart.draw(data, options);
      }')

   return
    (,
    ,
    )
};

let $accepted-collections := string-join(export:build-collection-tree(true()),',')

let $count-queries := 'entities,documents'

let $request := export:request-parameters( (<view default="table" accept="csv,table,xml"/>,
                                            (:<count accept="{$count-queries}"/>,:)
                                            <entity/>,
                                            <collection accept="{$accepted-collections}"/>) )

let $options := export:options( (
                                  (:<count explanation="choose example query" select="{$count-queries}"/>,:)
                                  <view explanation="view output as html table or plain text csv" select="csv,table"/>,
                                  <entity explanation="entity as wikilink to search for"/>,
                                  <collection explanation="available leaf collections" select="{$accepted-collections}"/>,
                                  <entity-escaped value="{local:fix-wikilink-input($request)}" explanation="escaped wiki link used for querying"/>
                                ),
                                $request)

let $collection := local:select-collection($request)

(:let $xml-output := if ($request/@count eq 'entities') then local:entities($collection,$request)
                   else if ($request/@count eq 'documents') then local:documents($collection,$request)
                   else ():)
(:let $xml-output := local:documents-per-month($collection,$request):)
let $xml-output := local:documents-per-month-efficient($collection,$request)
(:let $xml-output := local:documents-per-year($collection,$request):)
(:let $xml-output := local:documents-per-day($collection,$request):)

let $introduction-html :=

Below a timeline is shown for a previously detected (pre-computed) Wikipedia entity link.
         Data is shown per month, with both the number of documents, and total number of mentions within these documents.

Clicking the chart on a specific point will link to a search for the actual documents.

      {local:chart-container()}

let $search-form := export:html-util-generate-search-form($options, $request)

(:  :let $output := if ($request/@view eq 'table') then ($introduction-html, $search-form, export:html-output($xml-output)) :)
let $output := if ($request/@view eq 'table') then ($introduction-html, $search-form)
               else if ($request/@view eq 'csv') then export:csv-output($xml-output)
               else if ($request/@view eq 'xml') then $xml-output
               else ()

let $script-data := local:chart-line($xml-output)

(:let $output := export:output($request/@view, $output, 'ODE-II FoLiA Entity Search'):)
let $output := local:output-html($output, $script-data, $request, 'ODE-II FoLiA Entity Search', '')

let $serialization := export:set-serialization( if ($request/@view eq 'table') then 'html' else if ($request/@view eq 'csv') then 'text' else 'xml' )

return $output


MarkLogic: Create a local:eval-static-check helper function.

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

import module namespace sem = "http://marklogic.com/semantics" at "/MarkLogic/semantics.xqy";

declare namespace o = "http://reecedunn.co.uk/xquery/options";
declare namespace eval = "xdmp:eval";

declare option o:implementation "marklogic/6.0";

(:~ Run a query on a MarkLogic server.
 :
 : @param $mode Whether to "run", "profile", or "debug" the query.
 : @param $mimetype The mimetype of the query.
 : @param $module-path The path of the module to invoke, or "" for evaluated scripts.
 : @param $query The query script to evaluate, or "" for invoked modules.
 : @param $vars A map of the variable values by the variable name.
 : @param $types A map of the variable types by the variable name.
 : @param $context-value The context item for XSLT queries as an XML object.
 : @param $context-path The context item for XSLT queries as a module file.
 : @param $rdf-output-format The mimetype to format sem:triple results as, or "" to leave them as is.
 : @param $updating An updating query if "true", or a non-updating query if "false".
 : @param $server The name of the server to use, or "" to not use a server.
 : @param $database The name of the database to use, or "" to not use a database.
 : @param $module-root The path to the server modules, or "" to use the default server value.
 :
 : This script has additional logic to map the semantics of the REST/XCC API to
 : the semantics of the API implemented in the xquery-intellij-plugin to support
 : the Run/Debug Configurations of the IntelliJ IDEs. Specifically:
 :
 : 1.  If there is an error, the REST API returns a "500 Internal Error" HTTP
 :     status. This catches the error and returns an element(err:error) object.
 :
 : 2.  The variables are passed via the REST API as xs:untypedAtomic. This
 :     converts the variables to the type they were specified as in the
 :     xquery-intellij-plugin API.
 :
 : 3.  The REST API only returns the primitive type of each item.
 :)

declare variable $mode as xs:string external := "run";
declare variable $mimetype as xs:string external := "application/xquery";
declare variable $module-path as xs:string external := "";
declare variable $query as xs:string external := "()";
declare variable $vars as xs:string external := "{}";
declare variable $types as xs:string external := "{}";
declare variable $context-value as xs:string external := "";
declare variable $context-path as xs:string external := "";
declare variable $rdf-output-format as xs:string external := "";
declare variable $updating as xs:string external := "false";
declare variable $server as xs:string external := "";
declare variable $database as xs:string external := "";
declare variable $module-root as xs:string external := "";

declare variable $content-type-header-prefix as xs:string external := "X-Content-Type-";
declare variable $derived-type-header-prefix as xs:string external := "X-Derived-";

declare function local:nullize($value) {
    if (string-length($value) eq 0) then () else $value
};

declare function local:version() {
    substring-before(xdmp:version(), "-") cast as xs:double
};

declare function local:version-minor() {
    substring-after(xdmp:version(), "-") cast as xs:double
};

declare function local:function($ref as xs:string) {
    try { xdmp:eval($ref) } catch * { () }
};

declare function local:item($path as xs:string, $value as xs:string, $type as xs:string) {
    if (string-length($value) ne 0) then
        xdmp:unquote($value)
    else if (string-length($path) ne 0) then
        doc($path)
    else
        ()
};

declare function local:cast-as($value, $type) {
    switch ($type)
    case "xs:anyURI" return $value cast as xs:anyURI
    case "xs:base64Binary" return $value cast as xs:base64Binary
    case "xs:boolean" return $value cast as xs:boolean
    case "xs:byte" return $value cast as xs:byte
    case "xs:date" return $value cast as xs:date
    case "xs:dateTime" return $value cast as xs:dateTime
    case "xs:dateTimeStamp" return $value cast as xs:dateTime (: MarkLogic does not support XML Schema 1.1 Part 2 :)
    case "xs:dayTimeDuration" return $value cast as xs:dayTimeDuration
    case "xs:decimal" return $value cast as xs:decimal
    case "xs:double" return $value cast as xs:double
    case "xs:duration" return $value cast as xs:duration
    case "xs:float" return $value cast as xs:float
    case "xs:gDay" return $value cast as xs:gDay
    case "xs:gMonth" return $value cast as xs:gMonth
    case "xs:gMonthDay" return $value cast as xs:gMonthDay
    case "xs:gYear" return $value cast as xs:gYear
    case "xs:gYearMonth" return $value cast as xs:gYearMonth
    case "xs:hexBinary" return $value cast as xs:hexBinary
    case "xs:int" return $value cast as xs:int
    case "xs:integer" return $value cast as xs:integer
    case "xs:language" return $value cast as xs:language
    case "xs:long" return $value cast as xs:long
    case "xs:negativeInteger" return $value cast as xs:negativeInteger
    case "xs:nonNegativeInteger" return $value cast as xs:nonNegativeInteger
    case "xs:nonPositiveInteger" return $value cast as xs:nonPositiveInteger
    case "xs:normalizedString" return $value cast as xs:normalizedString
    case "xs:numeric" return $value cast as xs:numeric
    case "xs:positiveInteger" return $value cast as xs:positiveInteger
    case "xs:short" return $value cast as xs:short
    case "xs:string" return $value cast as xs:string
    case "xs:time" return $value cast as xs:time
    case "xs:token" return $value cast as xs:token
    case "xs:unsignedByte" return $value cast as xs:unsignedByte
    case "xs:unsignedInt" return $value cast as xs:unsignedInt
    case "xs:unsignedLong" return $value cast as xs:unsignedLong
    case "xs:unsignedShort" return $value cast as xs:unsignedShort
    case "xs:yearMonthDuration" return $value cast as xs:yearMonthDuration
    case "xs:ENTITY" return $value cast as xs:ENTITY
    case "xs:ID" return $value cast as xs:ID
    case "xs:IDREF" return $value cast as xs:IDREF
    case "xs:Name" return $value cast as xs:Name
    case "xs:NCName" return $value cast as xs:NCName
    case "xs:NMTOKEN" return $value cast as xs:NMTOKEN
    case "xs:QName" return $value cast as xs:QName
    default return $value
};

declare function local:parse-vars($values as map:map, $types as map:map) as item()* {
    for $key in map:keys($values)
    let $value := local:cast-as(map:get($values, $key), map:get($types, $key))
    return (xs:QName($key), $value)
};

declare function local:parse-vars-map($values as map:map, $types as map:map) as map:map {
    let $ret := map:map()
    let $_ :=
        for $key in map:keys($values)
        let $value := local:cast-as(map:get($values, $key), map:get($types, $key))
        return map:put($ret, $key, $value)
    return $ret
};

declare function local:derived-type-name($value) {
    (: NOTE: Ordering is important here -- reverse type hierarchy :)
    typeswitch ($value)
    case function(*) return "function(*)"
    (: xs:integer derived types :)
    case xs:positiveInteger return "xs:positiveInteger"
    case xs:unsignedByte return "xs:unsignedByte"
    case xs:unsignedShort return "xs:unsignedShort"
    case xs:unsignedInt return "xs:unsignedInt"
    case xs:unsignedLong return "xs:unsignedLong"
    case xs:nonNegativeInteger return "xs:nonNegativeInteger"
    case xs:byte return "xs:byte"
    case xs:short return "xs:short"
    case xs:int return "xs:int"
    case xs:long return "xs:long"
    case xs:negativeInteger return "xs:negativeInteger"
    case xs:nonPositiveInteger return "xs:nonPositiveInteger"
    (: xs:string derived types :)
    case xs:ENTITY return "xs:ENTITY"
    case xs:IDREF return "xs:IDREF"
    case xs:ID return "xs:ID"
    case xs:NCName return "xs:NCName"
    case xs:Name return "xs:Name"
    case xs:NMTOKEN return "xs:NMTOKEN"
    case xs:language return "xs:language"
    case xs:token return "xs:token"
    case xs:normalizedString return "xs:normalizedString"
    default return () (: primitive type, so does not need the type name to be specified. :)
};

declare function local:rdf-format($mimetype) {
    switch ($mimetype)
    case "application/n-quads" return "nquad"
    case "application/n-triples" return "ntriple"
    case "application/rdf+json" return "rdfjson"
    case "application/rdf+xml" return "rdfxml"
    case "application/trig" return "trig"
    case "application/vnd.marklogic.triples+xml" return "triplexml"
    case "text/n3" return "n3"
    case "text/turtle" return "turtle"
    default return fn:error("UNSUPPORTED-RDF-FORMAT", "Unsupported RDF format: " || $mimetype)
};

declare function local:use-modules-root($server-root) {
    exists($server-root) and string-length($module-root) ne 0 and not($module-root eq $server-root)
};

declare function local:eval-static-check($static-check as xs:boolean) {
    <eval:static-check>{$static-check}</eval:static-check>
};

declare function local:eval-options() {
    let $server := local:nullize($server) ! xdmp:server(.)
    let $database :=
        let $id := local:nullize($database) ! xdmp:database(.)
        return if (exists($id)) then
            $id
        else if (exists($server)) then
            xdmp:server-database($server)
        else
            ()
    return <eval:options>{
        local:eval-static-check($mode eq "validate"),
        if (exists($database)) then
            <eval:database>{$database}</eval:database>
        else
            (),
        if (exists($server)) then
            <eval:default-collation>{xdmp:server-collation($server)}</eval:default-collation>
        else
            (),
        let $server-coordinate-system := local:function("xdmp:server-coordinate-system#1")
        return if (exists($server) and exists($server-coordinate-system)) then
            <eval:default-coordinate-system>{$server-coordinate-system($server)}</eval:default-coordinate-system>
        else
            (),
        if (exists($server) and $mimetype eq "application/xquery") then
            <eval:default-xquery-version>{xdmp:server-default-xquery-version($server)}</eval:default-xquery-version>
        else
            (),
        let $server-root := $server ! xdmp:server-root(.)
        return if (local:use-modules-root($server-root)) then
            (<eval:modules>0</eval:modules>, <eval:root>{$module-root}</eval:root>) (: file system :)
        else
            (), (: use the default server settings :)
        let $major := local:version()
        let $minor := local:version-minor()
        return if ($mode = "debug") then
            if ($updating = "true") then
                fn:error(xs:QName("err:FOER0000"), "Debugging an update query is not supported by MarkLogic.")
            else
                ()
        else if ($major lt 7.0 or ($major eq 8.0 and $minor lt 7.0) or ($major eq 9.0 and $minor lt 2.0)) then
            if ($updating = "true") then
                <eval:transaction-mode>update</eval:transaction-mode>
            else
                <eval:transaction-mode>query</eval:transaction-mode>
        else
            (: MarkLogic 8.0-7 and 9.0-2 support <update> :)
            <eval:update>{$updating}</eval:update>
    }</eval:options>
};

declare function local:javascript() as item()* {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $options := local:eval-options()
    return if (local:version() < 8.0) then
        fn:error(
            xs:QName("UNSUPPORTED-VERSION"),
            "MarkLogic " || xdmp:version() || " does not support server-side JavaScript"
        )
    else if (string-length($query) ne 0) then
        switch ($mode)
        case "run" return
            let $f := local:function("xdmp:javascript-eval#3")
            let $start := xdmp:elapsed-time()
            let $ret := $f($query, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        default return ()
    else
        switch ($mode)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:invoke($module-path, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        default return ()
};

declare function local:sparql-query() as item()* {
    let $variables := local:parse-vars-map(xdmp:unquote($vars), xdmp:unquote($types))
    let $query :=
        if (string-length($query) ne 0) then
            $query
        else
            () (: TODO: Read the contents of the query file from the modules database. :)
    return switch ($mode)
    case "run" return
        let $start := xdmp:elapsed-time()
        let $ret := sem:sparql($query, $variables)
        return (xdmp:elapsed-time() - $start, $ret)
    default return ()
};

declare function local:sparql-update() as item()* {
    let $variables := local:parse-vars-map(xdmp:unquote($vars), xdmp:unquote($types))
    let $query :=
        if (string-length($query) ne 0) then
            $query
        else
            () (: TODO: Read the contents of the query file from the modules database. :)
    return if (local:version() < 8.0) then
        fn:error(
            xs:QName("UNSUPPORTED-VERSION"),
            "MarkLogic " || xdmp:version() || " does not support SPARQL update queries"
        )
    else switch ($mode)
    case "run" return
        let $start := xdmp:elapsed-time()
        let $ret := sem:sparql-update($query, $variables)
        return (xdmp:elapsed-time() - $start, $ret)
    default return ()
};

declare function local:sql() as item()* {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $query :=
        if (string-length($query) ne 0) then
            $query
        else
            () (: TODO: Read the contents of the query file from the modules database. :)
    return switch ($mode)
    case "run" return
        if (local:version() < 9.0) then
            let $f := local:function("xdmp:sql#1")
            let $start := xdmp:elapsed-time()
            let $ret := $f($query)
            return (xdmp:elapsed-time() - $start, $ret)
        else
            let $f := local:function("xdmp:sql#3")
            let $start := xdmp:elapsed-time()
            let $ret := $f($query, (), $variables)
            return (xdmp:elapsed-time() - $start, $ret)
    default return ()
};

declare function local:xquery() as item()* {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $options := local:eval-options()
    return if (string-length($query) ne 0) then
        switch ($mode)
        case "debug" return dbg:eval($query, $variables, $options)
        case "profile" return prof:eval($query, $variables, $options)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:eval($query, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp:eval($query, $variables, $options)
        default return ()
    else
        switch ($mode)
        case "debug" return dbg:invoke($module-path, $variables, $options)
        case "profile" return prof:invoke($module-path, $variables, $options)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:invoke($module-path, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp:invoke($module-path, $variables, $options)
        default return ()
};

declare function local:xslt() as item()* {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $input := local:item($context-path, $context-value, "application/xml")
    let $options := local:eval-options()
    return if (string-length($query) ne 0) then
        switch ($mode)
        case "profile" return prof:xslt-eval(xdmp:unquote($query), $input, $variables, $options)
        case "run" return
            let $query := xdmp:unquote($query)
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:xslt-eval($query, $input, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp:xslt-eval(xdmp:unquote($query), $input, $variables, $options)
        default return ()
    else
        switch ($mode)
        case "profile" return prof:xslt-invoke($module-path, $input, $variables, $options)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:xslt-invoke($module-path, $input, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp:xslt-invoke($module-path, $input, $variables, $options)
        default return ()
};

try {
    let $retvals :=
        switch ($mimetype)
        case "application/sparql-query" return local:sparql-query()
        case "application/sparql-update" return local:sparql-update()
        case "application/sql" return local:sql()
        case "application/vnd.marklogic-javascript" return local:javascript()
        case "application/xquery" return local:xquery()
        case "application/xslt+xml" return local:xslt()
        default return ()
    let $triples := for $item in $retvals where $item instance of sem:triple return $item
    let $retvals := for $item in $retvals where not($item instance of sem:triple) return $item
    return if (exists($triples) and $rdf-output-format ne "") then
        let $rdf-output := sem:rdf-serialize($triples, local:rdf-format($rdf-output-format))
        let $_ := xdmp:add-response-header($content-type-header-prefix || (count($retvals) + 1), $rdf-output-format)
        return (
            for $retval at $i in $retvals
            let $_ := local:derived-type-name($retval) ! xdmp:add-response-header($derived-type-header-prefix || $i, .)
            return $retval,
            $rdf-output
        )
    else
        for $retval at $i in ($retvals, $triples)
        let $_ := local:derived-type-name($retval) ! xdmp:add-response-header($derived-type-header-prefix || $i, .)
        return $retval
} catch * {
    let $_ := xdmp:add-response-header($derived-type-header-prefix || 1, "err:error")
    return $err:additional
}

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

import module namespace sem = "http://marklogic.com/semantics" at "/MarkLogic/semantics.xqy";

declare namespace o = "http://reecedunn.co.uk/xquery/options";
declare namespace eval = "xdmp:eval";

declare option o:implementation "marklogic/6.0";

(:~ Run a query on a MarkLogic server.
 :
 : @param $mode Whether to "run", "profile", or "debug" the query.
 : @param $mimetype The mimetype of the query.
 : @param $module-path The path of the module to invoke, or "" for evaluated scripts.
 : @param $query The query script to evaluate, or "" for invoked modules.
 : @param $vars A map of the variable values by the variable name.
 : @param $types A map of the variable types by the variable name.
 : @param $context-value The context item for XSLT queries as an XML object.
 : @param $context-path The context item for XSLT queries as a module file.
 : @param $rdf-output-format The mimetype to format sem:triple results as, or "" to leave them as is.
 : @param $updating An updating query if "true", or a non-updating query if "false".
 : @param $server The name of the server to use, or "" to not use a server.
 : @param $database The name of the database to use, or "" to not use a database.
 : @param $module-root The path to the server modules, or "" to use the default server value.
 :
 : This script has additional logic to map the semantics of the REST/XCC API to
 : the semantics of the API implemented in the xquery-intellij-plugin to support
 : the Run/Debug Configurations of the IntelliJ IDEs. Specifically:
 :
 : 1.  If there is an error, the REST API returns a "500 Internal Error" HTTP
 :     status. This catches the error and returns an element(err:error) object.
 :
 : 2.  The variables are passed via the REST API as xs:untypedAtomic. This
 :     converts the variables to the type they were specified as in the
 :     xquery-intellij-plugin API.
 :
 : 3.  The REST API only returns the primitive type of each item.
 :)

declare variable $mode as xs:string external := "run";
declare variable $mimetype as xs:string external := "application/xquery";
declare variable $module-path as xs:string external := "";
declare variable $query as xs:string external := "()";
declare variable $vars as xs:string external := "{}";
declare variable $types as xs:string external := "{}";
declare variable $context-value as xs:string external := "";
declare variable $context-path as xs:string external := "";
declare variable $rdf-output-format as xs:string external := "";
declare variable $updating as xs:string external := "false";
declare variable $server as xs:string external := "";
declare variable $database as xs:string external := "";
declare variable $module-root as xs:string external := "";

declare variable $content-type-header-prefix as xs:string external := "X-Content-Type-";
declare variable $derived-type-header-prefix as xs:string external := "X-Derived-";

declare function local:nullize($value) {
    if (string-length($value) eq 0) then () else $value
};

declare function local:version() {
    substring-before(xdmp:version(), "-") cast as xs:double
};

declare function local:version-minor() {
    substring-after(xdmp:version(), "-") cast as xs:double
};

declare function local:function($ref as xs:string) {
    try { xdmp:eval($ref) } catch * { () }
};

declare function local:item($path as xs:string, $value as xs:string, $type as xs:string) {
    if (string-length($value) ne 0) then
        xdmp:unquote($value)
    else if (string-length($path) ne 0) then
        doc($path)
    else
        ()
};

declare function local:cast-as($value, $type) {
    switch ($type)
    case "xs:anyURI" return $value cast as xs:anyURI
    case "xs:base64Binary" return $value cast as xs:base64Binary
    case "xs:boolean" return $value cast as xs:boolean
    case "xs:byte" return $value cast as xs:byte
    case "xs:date" return $value cast as xs:date
    case "xs:dateTime" return $value cast as xs:dateTime
    case "xs:dateTimeStamp" return $value cast as xs:dateTime (: MarkLogic does not support XML Schema 1.1 Part 2 :)
    case "xs:dayTimeDuration" return $value cast as xs:dayTimeDuration
    case "xs:decimal" return $value cast as xs:decimal
    case "xs:double" return $value cast as xs:double
    case "xs:duration" return $value cast as xs:duration
    case "xs:float" return $value cast as xs:float
    case "xs:gDay" return $value cast as xs:gDay
    case "xs:gMonth" return $value cast as xs:gMonth
    case "xs:gMonthDay" return $value cast as xs:gMonthDay
    case "xs:gYear" return $value cast as xs:gYear
    case "xs:gYearMonth" return $value cast as xs:gYearMonth
    case "xs:hexBinary" return $value cast as xs:hexBinary
    case "xs:int" return $value cast as xs:int
    case "xs:integer" return $value cast as xs:integer
    case "xs:language" return $value cast as xs:language
    case "xs:long" return $value cast as xs:long
    case "xs:negativeInteger" return $value cast as xs:negativeInteger
    case "xs:nonNegativeInteger" return $value cast as xs:nonNegativeInteger
    case "xs:nonPositiveInteger" return $value cast as xs:nonPositiveInteger
    case "xs:normalizedString" return $value cast as xs:normalizedString
    case "xs:numeric" return $value cast as xs:numeric
    case "xs:positiveInteger" return $value cast as xs:positiveInteger
    case "xs:short" return $value cast as xs:short
    case "xs:string" return $value cast as xs:string
    case "xs:time" return $value cast as xs:time
    case "xs:token" return $value cast as xs:token
    case "xs:unsignedByte" return $value cast as xs:unsignedByte
    case "xs:unsignedInt" return $value cast as xs:unsignedInt
    case "xs:unsignedLong" return $value cast as xs:unsignedLong
    case "xs:unsignedShort" return $value cast as xs:unsignedShort
    case "xs:yearMonthDuration" return $value cast as xs:yearMonthDuration
    case "xs:ENTITY" return $value cast as xs:ENTITY
    case "xs:ID" return $value cast as xs:ID
    case "xs:IDREF" return $value cast as xs:IDREF
    case "xs:Name" return $value cast as xs:Name
    case "xs:NCName" return $value cast as xs:NCName
    case "xs:NMTOKEN" return $value cast as xs:NMTOKEN
    case "xs:QName" return $value cast as xs:QName
    default return $value
};

declare function local:parse-vars($values as map:map, $types as map:map) as item()* {
    for $key in map:keys($values)
    let $value := local:cast-as(map:get($values, $key), map:get($types, $key))
    return (xs:QName($key), $value)
};

declare function local:parse-vars-map($values as map:map, $types as map:map) as map:map {
    let $ret := map:map()
    let $_ :=
        for $key in map:keys($values)
        let $value := local:cast-as(map:get($values, $key), map:get($types, $key))
        return map:put($ret, $key, $value)
    return $ret
};

declare function local:derived-type-name($value) {
    (: NOTE: Ordering is important here -- reverse type hierarchy :)
    typeswitch ($value)
    case function(*) return "function(*)"
    (: xs:integer derived types :)
    case xs:positiveInteger return "xs:positiveInteger"
    case xs:unsignedByte return "xs:unsignedByte"
    case xs:unsignedShort return "xs:unsignedShort"
    case xs:unsignedInt return "xs:unsignedInt"
    case xs:unsignedLong return "xs:unsignedLong"
    case xs:nonNegativeInteger return "xs:nonNegativeInteger"
    case xs:byte return "xs:byte"
    case xs:short return "xs:short"
    case xs:int return "xs:int"
    case xs:long return "xs:long"
    case xs:negativeInteger return "xs:negativeInteger"
    case xs:nonPositiveInteger return "xs:nonPositiveInteger"
    (: xs:string derived types :)
    case xs:ENTITY return "xs:ENTITY"
    case xs:IDREF return "xs:IDREF"
    case xs:ID return "xs:ID"
    case xs:NCName return "xs:NCName"
    case xs:Name return "xs:Name"
    case xs:NMTOKEN return "xs:NMTOKEN"
    case xs:language return "xs:language"
    case xs:token return "xs:token"
    case xs:normalizedString return "xs:normalizedString"
    default return () (: primitive type, so does not need the type name to be specified. :)
};

declare function local:rdf-format($mimetype) {
    switch ($mimetype)
    case "application/n-quads" return "nquad"
    case "application/n-triples" return "ntriple"
    case "application/rdf+json" return "rdfjson"
    case "application/rdf+xml" return "rdfxml"
    case "application/trig" return "trig"
    case "application/vnd.marklogic.triples+xml" return "triplexml"
    case "text/n3" return "n3"
    case "text/turtle" return "turtle"
    default return fn:error("UNSUPPORTED-RDF-FORMAT", "Unsupported RDF format: " || $mimetype)
};

declare function local:use-modules-root($server-root) {
    exists($server-root) and string-length($module-root) ne 0 and not($module-root eq $server-root)
};

declare function local:eval-options() {
    let $server := local:nullize($server) ! xdmp:server(.)
    let $database :=
        let $id := local:nullize($database) ! xdmp:database(.)
        return if (exists($id)) then
            $id
        else if (exists($server)) then
            xdmp:server-database($server)
        else
            ()
    return <eval:options>{
        if ($mode eq "validate") then
            <eval:static-check>true</eval:static-check>
        else
            (),
        if (exists($database)) then
            <eval:database>{$database}</eval:database>
        else
            (),
        if (exists($server)) then
            <eval:default-collation>{xdmp:server-collation($server)}</eval:default-collation>
        else
            (),
        let $server-coordinate-system := local:function("xdmp:server-coordinate-system#1")
        return if (exists($server) and exists($server-coordinate-system)) then
            <eval:default-coordinate-system>{$server-coordinate-system($server)}</eval:default-coordinate-system>
        else
            (),
        if (exists($server) and $mimetype eq "application/xquery") then
            <eval:default-xquery-version>{xdmp:server-default-xquery-version($server)}</eval:default-xquery-version>
        else
            (),
        let $server-root := $server ! xdmp:server-root(.)
        return if (local:use-modules-root($server-root)) then
            (<eval:modules>0</eval:modules>, <eval:root>{$module-root}</eval:root>) (: file system :)
        else
            (), (: use the default server settings :)
        let $major := local:version()
        let $minor := local:version-minor()
        return if ($mode = "debug") then
            if ($updating = "true") then
                fn:error(xs:QName("err:FOER0000"), "Debugging an update query is not supported by MarkLogic.")
            else
                ()
        else if ($major lt 7.0 or ($major eq 8.0 and $minor lt 7.0) or ($major eq 9.0 and $minor lt 2.0)) then
            if ($updating = "true") then
                <eval:transaction-mode>update</eval:transaction-mode>
            else
                <eval:transaction-mode>query</eval:transaction-mode>
        else
            (: MarkLogic 8.0-7 and 9.0-2 support <update> :)
            <eval:update>{$updating}</eval:update>
    }</eval:options>
};

declare function local:javascript() as item()* {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $options := local:eval-options()
    return if (local:version() < 8.0) then
        fn:error(
            xs:QName("UNSUPPORTED-VERSION"),
            "MarkLogic " || xdmp:version() || " does not support server-side JavaScript"
        )
    else if (string-length($query) ne 0) then
        switch ($mode)
        case "run" return
            let $f := local:function("xdmp:javascript-eval#3")
            let $start := xdmp:elapsed-time()
            let $ret := $f($query, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        default return ()
    else
        switch ($mode)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:invoke($module-path, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        default return ()
};

declare function local:sparql-query() as item()* {
    let $variables := local:parse-vars-map(xdmp:unquote($vars), xdmp:unquote($types))
    let $query :=
        if (string-length($query) ne 0) then
            $query
        else
            () (: TODO: Read the contents of the query file from the modules database. :)
    return switch ($mode)
    case "run" return
        let $start := xdmp:elapsed-time()
        let $ret := sem:sparql($query, $variables)
        return (xdmp:elapsed-time() - $start, $ret)
    default return ()
};

declare function local:sparql-update() as item()* {
    let $variables := local:parse-vars-map(xdmp:unquote($vars), xdmp:unquote($types))
    let $query :=
        if (string-length($query) ne 0) then
            $query
        else
            () (: TODO: Read the contents of the query file from the modules database. :)
    return if (local:version() < 8.0) then
        fn:error(
            xs:QName("UNSUPPORTED-VERSION"),
            "MarkLogic " || xdmp:version() || " does not support SPARQL update queries"
        )
    else switch ($mode)
    case "run" return
        let $start := xdmp:elapsed-time()
        let $ret := sem:sparql-update($query, $variables)
        return (xdmp:elapsed-time() - $start, $ret)
    default return ()
};

declare function local:sql() as item()* {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $query :=
        if (string-length($query) ne 0) then
            $query
        else
            () (: TODO: Read the contents of the query file from the modules database. :)
    return switch ($mode)
    case "run" return
        if (local:version() < 9.0) then
            let $f := local:function("xdmp:sql#1")
            let $start := xdmp:elapsed-time()
            let $ret := $f($query)
            return (xdmp:elapsed-time() - $start, $ret)
        else
            let $f := local:function("xdmp:sql#3")
            let $start := xdmp:elapsed-time()
            let $ret := $f($query, (), $variables)
            return (xdmp:elapsed-time() - $start, $ret)
    default return ()
};

declare function local:xquery() as item()* {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $options := local:eval-options()
    return if (string-length($query) ne 0) then
        switch ($mode)
        case "debug" return dbg:eval($query, $variables, $options)
        case "profile" return prof:eval($query, $variables, $options)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:eval($query, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp:eval($query, $variables, $options)
        default return ()
    else
        switch ($mode)
        case "debug" return dbg:invoke($module-path, $variables, $options)
        case "profile" return prof:invoke($module-path, $variables, $options)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:invoke($module-path, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp:invoke($module-path, $variables, $options)
        default return ()
};

declare function local:xslt() as item()* {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $input := local:item($context-path, $context-value, "application/xml")
    let $options := local:eval-options()
    return if (string-length($query) ne 0) then
        switch ($mode)
        case "profile" return prof:xslt-eval(xdmp:unquote($query), $input, $variables, $options)
        case "run" return
            let $query := xdmp:unquote($query)
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:xslt-eval($query, $input, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp:xslt-eval(xdmp:unquote($query), $input, $variables, $options)
        default return ()
    else
        switch ($mode)
        case "profile" return prof:xslt-invoke($module-path, $input, $variables, $options)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:xslt-invoke($module-path, $input, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp:xslt-invoke($module-path, $input, $variables, $options)
        default return ()
};

try {
    let $retvals :=
        switch ($mimetype)
        case "application/sparql-query" return local:sparql-query()
        case "application/sparql-update" return local:sparql-update()
        case "application/sql" return local:sql()
        case "application/vnd.marklogic-javascript" return local:javascript()
        case "application/xquery" return local:xquery()
        case "application/xslt+xml" return local:xslt()
        default return ()
    let $triples := for $item in $retvals where $item instance of sem:triple return $item
    let $retvals := for $item in $retvals where not($item instance of sem:triple) return $item
    return if (exists($triples) and $rdf-output-format ne "") then
        let $rdf-output := sem:rdf-serialize($triples, local:rdf-format($rdf-output-format))
        let $_ := xdmp:add-response-header($content-type-header-prefix || (count($retvals) + 1), $rdf-output-format)
        return (
            for $retval at $i in $retvals
            let $_ := local:derived-type-name($retval) ! xdmp:add-response-header($derived-type-header-prefix || $i, .)
            return $retval,
            $rdf-output
        )
    else
        for $retval at $i in ($retvals, $triples)
        let $_ := local:derived-type-name($retval) ! xdmp:add-response-header($derived-type-header-prefix || $i, .)
        return $retval
} catch * {
    let $_ := xdmp:add-response-header($derived-type-header-prefix || 1, "err:error")
    return $err:additional
}


To display the system status param

To display the system status param

xquery version "1.0";

(: ~
 : Module Name:             edit context webpage and XQuery
 :
 : Module Version           2.0
 :
 : Date                     31st July 2009
 :
 : Copyright                The cagrid consortium
 :
 : Module overview          edit context information
 :
 :)

(:~
 :    @author Rakesh Dhaval
      @author Puneet Mathur
 :    @version 0.2
 :
 :    Display System Status
~ :)

  import module namespace
  lib-forms="http://www.cagrid.org/xquery/library/forms"
  at "../edit/m-lib-forms.xquery";

  import module namespace
  lib-util="http://www.cagrid.org/xquery/library/util"
  at "../library/m-lib-util.xquery";

  import module namespace
  lib-rendering="http://www.cagrid.org/xquery/library/rendering"
  at "../web/m-lib-rendering.xquery";

  import module namespace
  lib-make-admin-item="http://www.cagrid.org/xquery/library/make-admin-item"
  at "../edit/m-lib-make-admin-item.xquery";

declare namespace openMDR = "http://www.cagrid.org/schema/openMDR";
declare namespace ISO11179= "http://www.cagrid.org/schema/ISO11179";
declare namespace session="http://exist-db.org/xquery/session";
declare namespace request="http://exist-db.org/xquery/request";
declare namespace response="http://exist-db.org/xquery/response";
declare namespace exist = "http://exist.sourceforge.net/NS/exist";
declare namespace util="http://exist-db.org/xquery/util";

declare namespace system = "http://exist-db.org/xquery/system";
declare namespace status = "http://exist-db.org/xquery/admin-interface/status";

declare function status:status-line($key as xs:string, $value as xs:string) as element()
{

        {$key}:
        {$value}

};

declare function local:success-page()
{
   let $calling-page := request:get-parameter("calling-page","")
   return

                This Page Displays the  System Status

General

            {
                status:status-line("eXist Version", system:get-version()),
                status:status-line("eXist Build", system:get-build()),
                status:status-line("eXist Home", system:get-exist-home()),
                status:status-line("SVN Revision", system:get-revision()),
                status:status-line("Java Vendor", util:system-property("java.vendor")),
                status:status-line("Java Version", util:system-property("java.version")),
                status:status-line("Operating System",
                    concat(util:system-property("os.name"), " ", util:system-property("os.version"),
                        " ", util:system-property("os.arch"))
                )
            }

Memory Usage

            {
                    let $max := system:get-memory-max() idiv 1024,
                    $current := system:get-memory-total() idiv 1024,
                    $free := system:get-memory-free() idiv 1024
                return (
                    status:status-line("Max. Memory", concat($max, "K")),
                    status:status-line("Current Total", concat($current, "K")),
                    status:status-line("Free", concat($free, "K"))
                )
            }

            Return to maintenance menu

};

declare option exist:serialize "media-type=text/html method=xhtml doctype-public=-//W3C//DTD XHTML 1.0 Transitional//EN doctype-system=http://www.w3.org/TR/2002/REC-xhtml1-20020801/DTD/xhtml1-transitional.dtd";

   session:create(),
   let $id := request:get-parameter('id','')
   let $title as xs:string := concat("System Status", $id)

   return
      lib-rendering:txfrm-webpage(
      $title,
      local:success-page()
         )

xquery version "1.0";

(: ~
 : Module Name:             edit context webpage and XQuery
 :
 : Module Version           2.0
 :
 : Date                     31st July 2009
 :
 : Copyright                The cagrid consortium
 :
 : Module overview          edit context information
 :
 :)

(:~
 :    @author Rakesh Dhaval
 :    @version 0.1
 :
 :    Edit Context information
~ :)

  import module namespace
  lib-forms="http://www.cagrid.org/xquery/library/forms"
  at "../edit/m-lib-forms.xquery";

  import module namespace
  lib-util="http://www.cagrid.org/xquery/library/util"
  at "../library/m-lib-util.xquery";

  import module namespace
  lib-rendering="http://www.cagrid.org/xquery/library/rendering"
  at "../web/m-lib-rendering.xquery";

  import module namespace
  lib-make-admin-item="http://www.cagrid.org/xquery/library/make-admin-item"
  at "../edit/m-lib-make-admin-item.xquery";

declare namespace openMDR = "http://www.cagrid.org/schema/openMDR";
declare namespace ISO11179= "http://www.cagrid.org/schema/ISO11179";
declare namespace session="http://exist-db.org/xquery/session";
declare namespace response="http://exist-db.org/xquery/response";
declare namespace exist = "http://exist.sourceforge.net/NS/exist";
declare namespace util="http://exist-db.org/xquery/util";

declare function local:success-page()
{
   let $calling-page := request:get-parameter("calling-page","")
   return

                System Status Coming soon...

            Return to maintenance menu

};

declare option exist:serialize "media-type=text/html method=xhtml doctype-public=-//W3C//DTD XHTML 1.0 Transitional//EN doctype-system=http://www.w3.org/TR/2002/REC-xhtml1-20020801/DTD/xhtml1-transitional.dtd";

   session:create(),
   let $id := request:get-parameter('id','')
   let $title as xs:string := concat(" System Status", $id)

   return
      lib-rendering:txfrm-webpage(
      $title,
      local:success-page()
         )