Corrected version number and page titles.

(:~
 : DITA for Small Teams
 :
 : Link management application RESTXQ implementation.
 :
 : Copyright (c) 2015 DITA for Small Teams (dita-for-small-teams.org)
 :
 : See the BaseX RESTXQ documentation for details on how the RESTXQ
 : mechanism works.
 :
 :)
module namespace page = 'http://basex.org/modules/web-page';

import module namespace html = 'dba/html' at 'dba/modules/html.xqm';
import module namespace bxutil="http://dita-for-small-teams.org/xquery/modules/basex-utils";
import module namespace lmutil="http://dita-for-small-teams.org/xquery/modules/linkmgmt-utils";
import module namespace df="http://dita-for-small-teams.org/xquery/modules/dita-utils";
import module namespace linkmgr='http://basex.org/modules/linkmgr' at "linkmgrViews.xqm";
import module namespace lmm="http://dita-for-small-teams.org/xquery/modules/linkmgr-model";
import module namespace lmc="http://dita-for-small-teams.org/xquery/modules/linkmgr-controller";
import module namespace d4stcnst="http://dita-for-small-teams.org/xquery/modules/d4st-constants";

(:~
 : This function generates the welcome page.
 : @return HTML page
 :)
declare
  %rest:path("/")
  %output:method("xhtml")
  %output:omit-xml-declaration("no")
  %output:doctype-public("-//W3C//DTD XHTML 1.0 Transitional//EN")
  %output:doctype-system("http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
  function page:start()
  as element(Q{http://www.w3.org/1999/xhtml}html)
{

      <title>DITA for Small Teams Link Manager</title>
      <link rel="stylesheet" type="text/css" href="static/style.css"/>

www.d4st.org

[Rel 0.9.7] DITA for Small Teams Link Manager

Repositories and Branches

                Repository
                Branches

            {page:listReposAndBranches()}

};

declare
  %rest:path("/repo/{$repo}/{$branch}")
  %rest:query-param("infoMessage",    "{$infoMessage}")
  %output:method("xhtml")
  %output:omit-xml-declaration("no")
  %output:doctype-public("-//W3C//DTD XHTML 1.0 Transitional//EN")
  %output:doctype-system("http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
  function page:branchMainView($repo as xs:string, $branch as xs:string, $infoMessage as xs:string?)
  as element(Q{http://www.w3.org/1999/xhtml}html)
{

      <title>D4ST {$repo}/{$branch}</title>
      <link rel="stylesheet" type="text/css" href="/static/style.css"/>

www.d4st.org

Git repo {$repo}/{$branch}

      [Update Link Management Indexes]
      [List all links]
      { if ($infoMessage and $infoMessage != '')
           then
{$infoMessage}

           else ()
      }

DITA Maps

                Title
                Path
                Root Map
                Actions

            { if (false())
                 then
No maps found

                 else page:listMapsInBranch($repo, $branch)
            }

DITA Topics

                Title
                Path
                Actions

            { if (false())
                 then
No maps found

                 else page:listTopicsInBranch($repo, $branch)
            }

};

(:~
 : List the databases that represent git repositories and branches
 : within those repositories.
 :
 : Result is a set of HTML table rows.
 :)
 declare function page:listReposAndBranches() as element()* {

    (: Get the repository info as an XML structure :)
    let $repos := bxutil:getGitRepositoryInfos()
    for $repo in $repos (: Sequence of <repo> elements :)
        let $branch := $repo/branch[1]
        let $path := concat($repo/@name, '/', $branch/@name)
        let $target := concat($repo/@name, '_', $branch/@name)
        return (

         {string($repo/@name)}
         {string($branch/@name)}

,
        for $branch in $repo/branch[position() gt 1]
            let $path := concat($repo/@name, '/', $branch/@name)
            let $target := concat($repo/@name, '_', $branch/@name)
            return

               {string($branch/@name)}

        )
        (:

      some repo
      master

,

      develop

    :)
 };

(:~
 : List the DITA maps within the specified branch of the specified repository.
 :
 : Result is a set of HTML table rows.
 :)
 declare function page:listMapsInBranch($repo as xs:string, $branch as xs:string) as element()* {
    let $dbName := bxutil:getDbNameForRepoAndBranch($repo, $branch)
    let $maps := df:getMaps($dbName)
    for $map in $maps
      let $docURI := document-uri($map)
      return

        {df:getTitleText($map/*)}
        {linkmgr:makeLinkToDocSource(document-uri(root($map)))}
        {
          let $resolvedMap as element()? := lmutil:getResolvedMapForMap($map/*)
          return if (not($resolvedMap))
             then "?"
             else if (lmc:isRootMap($map))
                     then '✓'
                     else ''
        }

        [{lmutil:linkToTarget('Navigation Tree', concat('/linkmgr/navtreeView/', document-uri($map)),
         'navtree')}]
        [{lmutil:linkToTarget('Map Tree', concat('/linkmgr/maptreeView/', document-uri($map)), 'maptree')}]
        [{lmutil:linkToTarget('Dependencies', concat('/linkmgr/dependencyView/', document-uri($map)), 'dependencies')}]
        [{lmutil:linkToTarget('Reltables', concat('/linkmgr/reltableView/', document-uri($map)), 'reltables')}]
        [{lmutil:linkToTarget('Key Spaces', concat('/linkmgr/keyspaceView/', document-uri($map)), 'keyspaces')}]
        [{lmutil:linkToTarget('Preview', concat('/linkmgr/docview/', document-uri($map), '/preview'), 'preview')}]
        [{lmutil:linkToTarget('Where Used?', concat('/linkmgr/whereUsedView/', $docURI), 'whereused')}]
        [{lmutil:linkToTarget('Edit', lmutil:getOxygenWebAuthorUrl($repo, $branch, $docURI), 'edit')}]

 };

(:~
 : List the DITA topics within the specified branch of the specified repository.
 :
 : Result is a set of HTML table rows.
 :)
 declare function page:listTopicsInBranch($repo as xs:string, $branch as xs:string) as element()* {
    let $dbName := bxutil:getDbNameForRepoAndBranch($repo, $branch)
    let $topics := df:getTopicDocs($dbName)
    for $topic in $topics
      let $docURI := document-uri($topic)
      return

        {df:getTitleText($topic/*)}
        {linkmgr:makeLinkToDocSource(document-uri(root($topic)))}
        [{lmutil:linkToTarget('Where Used?', concat('/linkmgr/whereUsedView/', $docURI), 'whereused')}]
            [{lmutil:linkToTarget('Dependencies', concat('/linkmgr/dependencyView/', $docURI), 'dependencies')}]
            [{lmutil:linkToTarget('Preview', concat('/linkmgr/docview/', $docURI, '/preview'), 'preview')}]
            [{lmutil:linkToTarget('Edit', lmutil:getOxygenWebAuthorUrl($repo, $branch, $docURI), 'edit')}]

 };

(:~
 : This function returns an XML response message.
 : @param $world  string to be included in the response
 : @return response element
 :)
declare
  %rest:path("/linkmgr")
  %rest:GET
  function page:linkmgr(
    )
    as element(response)
{
  <response>
    <title>Linkmgr</title>
    <time>Link manager response: The current time is: { current-time() }</time>
  </response>
};

(: REST API to trigger creation or update of link management indexes. :)
declare
  %updating
  %rest:path("/repo/{$repo}/{$branch}/updateLinkManagementIndexes")
  %rest:GET
  %output:method("xhtml")
  %output:omit-xml-declaration("no")
  %output:doctype-public("-//W3C//DTD XHTML 1.0 Transitional//EN")
  %output:doctype-system("http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
  function page:updateLinkManagementIndexes($repo as xs:string, $branch as xs:string) {

  let $contentDbName := bxutil:getDbNameForRepoAndBranch($repo, $branch)
  let $metadataDbName := bxutil:getMetadataDbNameForRepoAndBranch($repo, $branch)
  let $logID := "lmindex-update-log"

  return db:output(web:redirect(concat("/repo/", $repo, "/", $branch, "/updateLMIStage1"),
                                 map { 'contentDbName' : $contentDbName,
                                       'metadataDbName' : $metadataDbName,
                                       'logID' : $logID
                                     }))
};

(: Link management index stage 1: Clear the database and construct all
 : direct link resource records. On return, redirects to stage 2.
 :)
declare
  %updating
  %rest:path("/repo/{$repo}/{$branch}/updateLMIStage1")
  %rest:query-param("contentDbName",  "{$contentDbName}")
  %rest:query-param("metadataDbName", "{$metadataDbName}")
  %rest:query-param("logID",          "{$logID}")
  %rest:GET
  %output:method("xhtml")
  %output:omit-xml-declaration("no")
  %output:doctype-public("-//W3C//DTD XHTML 1.0 Transitional//EN")
  %output:doctype-system("http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
  function page:updateStage1($repo as xs:string,
                             $branch as xs:string,
                             $contentDbName as xs:string,
                             $metadataDbName as xs:string,
                             $logID as xs:string) {

      try {
          lmc:updateLinkManagementIndexesStage1($contentDbName, $metadataDbName, $logID),
          db:output(web:redirect(concat("/repo/", $repo, "/", $branch, "/updateLMIStage2"),
                                 map { 'contentDbName' : $contentDbName,
                                       'metadataDbName' : $metadataDbName,
                                       'logID' : $logID
                                     }))
      } catch * {
      (: FIXME: Format the parts of the error message in a useful way :)
          db:output(web:redirect("/error",
                                 map { 'contentDbName' : $contentDbName,
                                       'metadataDbName' : $metadataDbName,
                                       'description' : $err:description,
                                       'module' : $err:module,
                                       'line-number' : $err:line-number,
                                       'column-number' : $err:column-number,
                                       'additional' : $err:additional,
                                       'logID' : $logID

                                     }))
      }

};

(:~
 : Link management index update stage 2: Construct key spaces.
 : On return redirects to stage 3.
 :)
declare
  %updating
  %rest:path("/repo/{$repo}/{$branch}/updateLMIStage2")
  %rest:query-param("contentDbName",  "{$contentDbName}")
  %rest:query-param("metadataDbName", "{$metadataDbName}")
  %rest:query-param("logID",          "{$logID}")
  %rest:GET
  %output:method("xhtml")
  %output:omit-xml-declaration("no")
  %output:doctype-public("-//W3C//DTD XHTML 1.0 Transitional//EN")
  %output:doctype-system("http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
  function page:updateStage2($repo as xs:string,
                             $branch as xs:string,
                             $contentDbName as xs:string,
                             $metadataDbName as xs:string,
                             $logID as xs:string
                             ) {
   try {

      lmc:updateLinkManagementIndexesStage2(
         $contentDbName,
         $metadataDbName,
         $logID),
      db:output(web:redirect(concat("/repo/", $repo, "/", $branch, "/updateLMIStage3"),
                                       map { 'contentDbName' : $contentDbName,
                                             'metadataDbName' : $metadataDbName,
                                             'logID' : $logID
                                           }))
    } catch * {
          db:output(web:redirect("/error",
                                 map { 'contentDbName' : $contentDbName,
                                       'metadataDbName' : $metadataDbName,
                                       'description' : $err:description,
                                       'module' : $err:module,
                                       'line-number' : $err:line-number,
                                       'column-number' : $err:column-number,
                                       'additional' : $err:additional,
                                       'logID' : $logID

                                     }))
    }

};

(:~
 : Link management index update stage 3: Construct indirect link
 : where-used records.
 : On return redirects back to the page for the repo and branch.
 :)
declare
  %updating
  %rest:path("/repo/{$repo}/{$branch}/updateLMIStage3")
  %rest:query-param("contentDbName",  "{$contentDbName}")
  %rest:query-param("metadataDbName", "{$metadataDbName}")
  %rest:query-param("logID",          "{$logID}")
  %rest:GET
  %output:method("xhtml")
  %output:omit-xml-declaration("no")
  %output:doctype-public("-//W3C//DTD XHTML 1.0 Transitional//EN")
  %output:doctype-system("http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
  function page:updateStage3($repo as xs:string,
                             $branch as xs:string,
                             $contentDbName as xs:string,
                             $metadataDbName as xs:string,
                             $logID as xs:string
                             ) {

    try {

      (lmc:updateLinkManagementIndexesStage3($contentDbName, $metadataDbName, $logID),
       db:output("Link management database updated"))
      (:,
      db:output(web:redirect(concat("/repo/", $repo, "/", $branch),
                                       map { 'infoMessage' : 'Link management indexes updated'
                                           }))
                                           :)

    } catch * {
          db:output(web:redirect("/error",
                                 map { 'contentDbName' : $contentDbName,
                                       'metadataDbName' : $metadataDbName,
                                       'description' : $err:description,
                                       'module' : $err:module,
                                       'line-number' : $err:line-number,
                                       'column-number' : $err:column-number,
                                       'additional' : $err:additional,
                                       'logID' : $logID

                                     }))
    }

};

(:~
 : Generic error report page. This is a placeholder in advance of more sophisticated
 : error reporting infrastructure.
 :)
declare
  %rest:path("/error")
  %rest:query-param("contentDbName",    "{$contentDbName}")
  %rest:query-param("metadataDbName", "{$metadataDbName}")
  %rest:query-param("description", "{$description}")
  %rest:query-param("module", "{$module}")
  %rest:query-param("line-number", "{$line-number}")
  %rest:query-param("column-number", "{$column-number}")
  %rest:query-param("additional", "{$additional}")
  %rest:GET
  %output:method("xhtml")
  %output:omit-xml-declaration("no")
  %output:doctype-public("-//W3C//DTD XHTML 1.0 Transitional//EN")
  %output:doctype-system("http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
  function page:reportError($contentDbName as xs:string?,
                            $metadataDbName as xs:string?,
                            $description as xs:string?,
                            $module as xs:string?,
                            $line-number as xs:string?,
                            $column-number as xs:string?,
                            $additional as xs:string?
                           ) {

     <title>Error</title>

Error

Error

content database: {$contentDbName}

Metadata database: {$metadataDbName}

{$module} [{$line-number}:{$column-number}]: {$description}

Trace:

      {
      $additional
      }

};

declare function page:formatLogAsHtml($log) as element() {

  {for $entry in $log/*
       return concat('[', upper-case(name($entry)), ']', ' ', string($entry), '
')
  }

};

(:~
 : DITA for Small Teams
 :
 : Link management application RESTXQ implementation.
 :
 : Copyright (c) 2015 DITA for Small Teams (dita-for-small-teams.org)
 :
 : See the BaseX RESTXQ documentation for details on how the RESTXQ
 : mechanism works.
 :
 :)
module namespace page = 'http://basex.org/modules/web-page';

import module namespace html = 'dba/html' at 'dba/modules/html.xqm';
import module namespace bxutil="http://dita-for-small-teams.org/xquery/modules/basex-utils";
import module namespace lmutil="http://dita-for-small-teams.org/xquery/modules/linkmgmt-utils";
import module namespace df="http://dita-for-small-teams.org/xquery/modules/dita-utils";
import module namespace linkmgr='http://basex.org/modules/linkmgr' at "linkmgrViews.xqm";
import module namespace lmm="http://dita-for-small-teams.org/xquery/modules/linkmgr-model";
import module namespace lmc="http://dita-for-small-teams.org/xquery/modules/linkmgr-controller";
import module namespace d4stcnst="http://dita-for-small-teams.org/xquery/modules/d4st-constants";

(:~
 : This function generates the welcome page.
 : @return HTML page
 :)
declare
  %rest:path("/")
  %output:method("xhtml")
  %output:omit-xml-declaration("no")
  %output:doctype-public("-//W3C//DTD XHTML 1.0 Transitional//EN")
  %output:doctype-system("http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
  function page:start()
  as element(Q{http://www.w3.org/1999/xhtml}html)
{

      <title>Dev DITA for Small Teams Link Manager</title>
      <link rel="stylesheet" type="text/css" href="static/style.css"/>

www.d4st.org

[Rel 0.9.7a] dev DITA for Small Teams Link Manager

Repositories and Branches

                Repository
                Branches

            {page:listReposAndBranches()}

};

declare
  %rest:path("/repo/{$repo}/{$branch}")
  %rest:query-param("infoMessage",    "{$infoMessage}")
  %output:method("xhtml")
  %output:omit-xml-declaration("no")
  %output:doctype-public("-//W3C//DTD XHTML 1.0 Transitional//EN")
  %output:doctype-system("http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
  function page:branchMainView($repo as xs:string, $branch as xs:string, $infoMessage as xs:string?)
  as element(Q{http://www.w3.org/1999/xhtml}html)
{

      <title>D4ST {$repo}/{$branch}</title>
      <link rel="stylesheet" type="text/css" href="/static/style.css"/>

www.d4st.org

Git repo {$repo}/{$branch}

      [Update Link Management Indexes]
      [List all links]
      { if ($infoMessage and $infoMessage != '')
           then
{$infoMessage}

           else ()
      }

DITA Maps

                Title
                Path
                Root Map
                Actions

            { if (false())
                 then
No maps found

                 else page:listMapsInBranch($repo, $branch)
            }

DITA Topics

                Title
                Path
                Actions

            { if (false())
                 then
No maps found

                 else page:listTopicsInBranch($repo, $branch)
            }

};

(:~
 : List the databases that represent git repositories and branches
 : within those repositories.
 :
 : Result is a set of HTML table rows.
 :)
 declare function page:listReposAndBranches() as element()* {

    (: Get the repository info as an XML structure :)
    let $repos := bxutil:getGitRepositoryInfos()
    for $repo in $repos (: Sequence of <repo> elements :)
        let $branch := $repo/branch[1]
        let $path := concat($repo/@name, '/', $branch/@name)
        let $target := concat($repo/@name, '_', $branch/@name)
        return (

         {string($repo/@name)}
         {string($branch/@name)}

,
        for $branch in $repo/branch[position() gt 1]
            let $path := concat($repo/@name, '/', $branch/@name)
            let $target := concat($repo/@name, '_', $branch/@name)
            return

               {string($branch/@name)}

        )
        (:

      some repo
      master

,

      develop

    :)
 };

(:~
 : List the DITA maps within the specified branch of the specified repository.
 :
 : Result is a set of HTML table rows.
 :)
 declare function page:listMapsInBranch($repo as xs:string, $branch as xs:string) as element()* {
    let $dbName := bxutil:getDbNameForRepoAndBranch($repo, $branch)
    let $maps := df:getMaps($dbName)
    for $map in $maps
      let $docURI := document-uri($map)
      return

        {df:getTitleText($map/*)}
        {linkmgr:makeLinkToDocSource(document-uri(root($map)))}
        {
          let $resolvedMap as element()? := lmutil:getResolvedMapForMap($map/*)
          return if (not($resolvedMap))
             then "?"
             else if (lmc:isRootMap($map))
                     then '✓'
                     else ''
        }

        [{lmutil:linkToTarget('Navigation Tree', concat('/linkmgr/navtreeView/', document-uri($map)),
         'navtree')}]
        [{lmutil:linkToTarget('Map Tree', concat('/linkmgr/maptreeView/', document-uri($map)), 'maptree')}]
        [{lmutil:linkToTarget('Dependencies', concat('/linkmgr/dependencyView/', document-uri($map)), 'dependencies')}]
        [{lmutil:linkToTarget('Reltables', concat('/linkmgr/reltableView/', document-uri($map)), 'reltables')}]
        [{lmutil:linkToTarget('Key Spaces', concat('/linkmgr/keyspaceView/', document-uri($map)), 'keyspaces')}]
        [{lmutil:linkToTarget('Preview', concat('/linkmgr/docview/', document-uri($map), '/preview'), 'preview')}]
        [{lmutil:linkToTarget('Where Used?', concat('/linkmgr/whereUsedView/', $docURI), 'whereused')}]
        [{lmutil:linkToTarget('Edit', lmutil:getOxygenWebAuthorUrl($repo, $branch, $docURI), 'edit')}]

 };

(:~
 : List the DITA topics within the specified branch of the specified repository.
 :
 : Result is a set of HTML table rows.
 :)
 declare function page:listTopicsInBranch($repo as xs:string, $branch as xs:string) as element()* {
    let $dbName := bxutil:getDbNameForRepoAndBranch($repo, $branch)
    let $topics := df:getTopicDocs($dbName)
    for $topic in $topics
      let $docURI := document-uri($topic)
      return

        {df:getTitleText($topic/*)}
        {linkmgr:makeLinkToDocSource(document-uri(root($topic)))}
        [{lmutil:linkToTarget('Where Used?', concat('/linkmgr/whereUsedView/', $docURI), 'whereused')}]
            [{lmutil:linkToTarget('Dependencies', concat('/linkmgr/dependencyView/', $docURI), 'dependencies')}]
            [{lmutil:linkToTarget('Preview', concat('/linkmgr/docview/', $docURI, '/preview'), 'preview')}]
            [{lmutil:linkToTarget('Edit', lmutil:getOxygenWebAuthorUrl($repo, $branch, $docURI), 'edit')}]

 };

(:~
 : This function returns an XML response message.
 : @param $world  string to be included in the response
 : @return response element
 :)
declare
  %rest:path("/linkmgr")
  %rest:GET
  function page:linkmgr(
    )
    as element(response)
{
  <response>
    <title>Linkmgr</title>
    <time>Link manager response: The current time is: { current-time() }</time>
  </response>
};

(: REST API to trigger creation or update of link management indexes. :)
declare
  %updating
  %rest:path("/repo/{$repo}/{$branch}/updateLinkManagementIndexes")
  %rest:GET
  %output:method("xhtml")
  %output:omit-xml-declaration("no")
  %output:doctype-public("-//W3C//DTD XHTML 1.0 Transitional//EN")
  %output:doctype-system("http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
  function page:updateLinkManagementIndexes($repo as xs:string, $branch as xs:string) {

  let $contentDbName := bxutil:getDbNameForRepoAndBranch($repo, $branch)
  let $metadataDbName := bxutil:getMetadataDbNameForRepoAndBranch($repo, $branch)
  let $logID := "lmindex-update-log"

  return db:output(web:redirect(concat("/repo/", $repo, "/", $branch, "/updateLMIStage1"),
                                 map { 'contentDbName' : $contentDbName,
                                       'metadataDbName' : $metadataDbName,
                                       'logID' : $logID
                                     }))
};

(: Link management index stage 1: Clear the database and construct all
 : direct link resource records. On return, redirects to stage 2.
 :)
declare
  %updating
  %rest:path("/repo/{$repo}/{$branch}/updateLMIStage1")
  %rest:query-param("contentDbName",  "{$contentDbName}")
  %rest:query-param("metadataDbName", "{$metadataDbName}")
  %rest:query-param("logID",          "{$logID}")
  %rest:GET
  %output:method("xhtml")
  %output:omit-xml-declaration("no")
  %output:doctype-public("-//W3C//DTD XHTML 1.0 Transitional//EN")
  %output:doctype-system("http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
  function page:updateStage1($repo as xs:string,
                             $branch as xs:string,
                             $contentDbName as xs:string,
                             $metadataDbName as xs:string,
                             $logID as xs:string) {

      try {
          lmc:updateLinkManagementIndexesStage1($contentDbName, $metadataDbName, $logID),
          db:output(web:redirect(concat("/repo/", $repo, "/", $branch, "/updateLMIStage2"),
                                 map { 'contentDbName' : $contentDbName,
                                       'metadataDbName' : $metadataDbName,
                                       'logID' : $logID
                                     }))
      } catch * {
      (: FIXME: Format the parts of the error message in a useful way :)
          db:output(web:redirect("/error",
                                 map { 'contentDbName' : $contentDbName,
                                       'metadataDbName' : $metadataDbName,
                                       'description' : $err:description,
                                       'module' : $err:module,
                                       'line-number' : $err:line-number,
                                       'column-number' : $err:column-number,
                                       'additional' : $err:additional,
                                       'logID' : $logID

                                     }))
      }

};

(:~
 : Link management index update stage 2: Construct key spaces.
 : On return redirects to stage 3.
 :)
declare
  %updating
  %rest:path("/repo/{$repo}/{$branch}/updateLMIStage2")
  %rest:query-param("contentDbName",  "{$contentDbName}")
  %rest:query-param("metadataDbName", "{$metadataDbName}")
  %rest:query-param("logID",          "{$logID}")
  %rest:GET
  %output:method("xhtml")
  %output:omit-xml-declaration("no")
  %output:doctype-public("-//W3C//DTD XHTML 1.0 Transitional//EN")
  %output:doctype-system("http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
  function page:updateStage2($repo as xs:string,
                             $branch as xs:string,
                             $contentDbName as xs:string,
                             $metadataDbName as xs:string,
                             $logID as xs:string
                             ) {
   try {

      lmc:updateLinkManagementIndexesStage2(
         $contentDbName,
         $metadataDbName,
         $logID),
      db:output(web:redirect(concat("/repo/", $repo, "/", $branch, "/updateLMIStage3"),
                                       map { 'contentDbName' : $contentDbName,
                                             'metadataDbName' : $metadataDbName,
                                             'logID' : $logID
                                           }))
    } catch * {
          db:output(web:redirect("/error",
                                 map { 'contentDbName' : $contentDbName,
                                       'metadataDbName' : $metadataDbName,
                                       'description' : $err:description,
                                       'module' : $err:module,
                                       'line-number' : $err:line-number,
                                       'column-number' : $err:column-number,
                                       'additional' : $err:additional,
                                       'logID' : $logID

                                     }))
    }

};

(:~
 : Link management index update stage 3: Construct indirect link
 : where-used records.
 : On return redirects back to the page for the repo and branch.
 :)
declare
  %updating
  %rest:path("/repo/{$repo}/{$branch}/updateLMIStage3")
  %rest:query-param("contentDbName",  "{$contentDbName}")
  %rest:query-param("metadataDbName", "{$metadataDbName}")
  %rest:query-param("logID",          "{$logID}")
  %rest:GET
  %output:method("xhtml")
  %output:omit-xml-declaration("no")
  %output:doctype-public("-//W3C//DTD XHTML 1.0 Transitional//EN")
  %output:doctype-system("http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
  function page:updateStage3($repo as xs:string,
                             $branch as xs:string,
                             $contentDbName as xs:string,
                             $metadataDbName as xs:string,
                             $logID as xs:string
                             ) {

    try {

      (lmc:updateLinkManagementIndexesStage3($contentDbName, $metadataDbName, $logID),
       db:output("Link management database updated"))
      (:,
      db:output(web:redirect(concat("/repo/", $repo, "/", $branch),
                                       map { 'infoMessage' : 'Link management indexes updated'
                                           }))
                                           :)

    } catch * {
          db:output(web:redirect("/error",
                                 map { 'contentDbName' : $contentDbName,
                                       'metadataDbName' : $metadataDbName,
                                       'description' : $err:description,
                                       'module' : $err:module,
                                       'line-number' : $err:line-number,
                                       'column-number' : $err:column-number,
                                       'additional' : $err:additional,
                                       'logID' : $logID

                                     }))
    }

};

(:~
 : Generic error report page. This is a placeholder in advance of more sophisticated
 : error reporting infrastructure.
 :)
declare
  %rest:path("/error")
  %rest:query-param("contentDbName",    "{$contentDbName}")
  %rest:query-param("metadataDbName", "{$metadataDbName}")
  %rest:query-param("description", "{$description}")
  %rest:query-param("module", "{$module}")
  %rest:query-param("line-number", "{$line-number}")
  %rest:query-param("column-number", "{$column-number}")
  %rest:query-param("additional", "{$additional}")
  %rest:GET
  %output:method("xhtml")
  %output:omit-xml-declaration("no")
  %output:doctype-public("-//W3C//DTD XHTML 1.0 Transitional//EN")
  %output:doctype-system("http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
  function page:reportError($contentDbName as xs:string?,
                            $metadataDbName as xs:string?,
                            $description as xs:string?,
                            $module as xs:string?,
                            $line-number as xs:string?,
                            $column-number as xs:string?,
                            $additional as xs:string?
                           ) {

     <title>Error</title>

Error

Error

content database: {$contentDbName}

Metadata database: {$metadataDbName}

{$module} [{$line-number}:{$column-number}]: {$description}

Trace:

      {
      $additional
      }

};

declare function page:formatLogAsHtml($log) as element() {

  {for $entry in $log/*
       return concat('[', upper-case(name($entry)), ']', ' ', string($entry), '
')
  }

};


tidy up

tidy up

xquery version "3.0";
(:~
: Node tree from a string
: based on http://www.xml.com/lpt/a/1472
:)
declare namespace svg= "http://www.w3.org/2000/svg";
declare variable $hedge.scale:=10;

declare function local:hedge2xml($hedge as xs:string) as element(node)*{
  if($hedge="") then ()
  else if (fn:substring($hedge, 1, 1)="{") then
    local:hedge2xml(fn:substring-before(fn:substring($hedge,2), '}'),fn:substring-after($hedge, '}'))
  else
    local:hedge2xml(fn:substring($hedge,1,1),fn:substring($hedge,2))
};

declare %private function local:hedge2xml($head as xs:string,$rest as xs:string) as element(node)* {
 if($head="(" or $head=")"  or $head="") then
   fn:error()
 else if (fn:substring($rest,1, 1)="(") then
   let $endPos:=local:closingParenPos2($rest,2,1)
   return (<node label="{$head}">{local:hedge2xml(substring($rest, 2, $endPos -2 ))}</node>
           ,local:hedge2xml(substring($rest, 1+$endPos))
           )
 else
     (<node label="{$head}"/> ,local:hedge2xml($rest))
};

declare function local:closingParenPos($text as xs:string,$pos as xs:integer ,$depth as xs:integer ) as xs:integer{
  switch (fn:true())
  (:  Found closing ) which is not nested. We are done. :)
  case fn:substring($text, $pos, 1) = ')' and $depth = 1
        return $pos
  (: Found opening (. Increase nesting depth and continue. :)
  case fn:substring($text,  $pos, 1) = '('
        return local:closingParenPos($text, $pos+1, $depth + 1)
  (: Found closing ) which is nested. Unwrap and continue on a shallower level. :)
  case fn:substring($text, $pos, 1) = ')'
        return local:closingParenPos($text, $pos+1, $depth - 1)
  (: End of text while nested. Something is wrong with input. :)
  case ($pos > string-length($text))  and $depth != 0
        return fn:error()
  default
        return local:closingParenPos($text, $pos+1, $depth)
};

(:---  alternative closingParenPos mades no difference ---:)

(:~
: @param $arg string to be searched
: @param $substring what to look for
: @param $startpos first position to search
: @return index or -1 if not found
:)
declare function local:string-index
( $arg as xs:string? , $substring as xs:string , $startPos as xs:integer )  as xs:integer {
  let $s:=substring($arg,$startPos)
  return if (contains($s, $substring))
         then $startPos+string-length(substring-before($s, $substring))
         else -1
};

declare function local:closingParenPos2($text as xs:string,$pos as xs:integer ,$depth as xs:integer ) as xs:integer{
  let $start:=local:string-index($text,"(",$pos)
  let $end:=local:string-index($text,")",$pos)
  let $pos:=trace($pos,   $start || "," || $end || "::")
  return
      if($end=-1 or $start=-1 or $end < $start ) then
          if($depth=1) then
          $end else
          local:closingParenPos2($text,$end+1,$depth -1)
      else  local:closingParenPos2($text,$start+1,$depth+1)
};

(: insert depth and width :)
declare function local:layout($element as element(),$depth) as element() {
   element {node-name($element)}
      {$element/@*,
       attribute{ "depth"}{ $depth},
       attribute{ "width"}{local:width($element)},
      for $child in $element/*
      return local:layout($child,$depth+1)
      }
};
declare function local:width($e){
  max((1,sum($e/*/local:width(.))))
};
declare function local:svg($layout){
let $maxDepth:=4
return
<svg:svg viewBox = "0 0 {sum($layout/node/@width) * 2 * $hedge.scale} {$maxDepth * 2 * $hedge.scale}">
    <!-- Note that some SVG implementations work better when you set explicit width and height also.
         In that case add following attributes to svg element:
            width="{sum($layout/node/@width)*5}mm"
            depth = "{$maxDepth*5}mm"
            preserveAspectRatio="xMidYMid meet" -->
    <svg:g transform = "translate(0,-{$hedge.scale div 2}) scale({$hedge.scale})">
      {for $node in $layout return local:drawnode($node)}
    </svg:g>
  </svg:svg>
};

declare function local:drawnode($node){
  (: Calculate X coordinate :)
  let $x:=(sum(preceding::node[$node/@depth = current()/$node/@depth or (not($node/node) and $node/@depth <= current()/@depth)]/@width) + ($node/@width div 2)) * 2
  (: Calculate Y coordinate :)
  let $y := $node/@depth * 2
  (: Draw label of node :)
  return
  (: text :)
  (<svg:text x = "{$x}"
            y = "{$y - 0.2}"
            style = "text-anchor: middle; font-size: 0.9;">
    {$node/@label}
  </svg:text>,
  (: rectangle :)
  <svg:rect x = "{$x - 0.9}" y="{$y - 1}" width = "1.8" height="1"
            rx = "0.4" ry = "0.4"
            style = "fill: none; stroke: black; stroke-width: 0.1;"/>,
  (: lines :)
  for $n in $node/node
  return
    <svg:line x1 = "{$x}"
              y1 = "{$y}"
              x2 = "{(sum($node/preceding::node[@depth = current()/@depth or (not($node/node) and @depth  <= current()/@depth)]/@width) + ($node/@width div 2)) * 2}"
              y2 = "{$node/@depth * 2 - 1}"
              style = "stroke-width: 0.1; stroke: black;"/>
 ,
 (: Draw sub-nodes :)
 for $n in  $node/node
 return local:drawnode($n)
};

let $hedge:="a(bcdef)"
let $t:=local:hedge2xml($hedge)
return  $t!local:layout(.,1)


Fixed Typos in transitive-lib.xqy

Fixed Typos in transitive-lib.xqy

xquery version "1.0-ml";

module namespace transitive = "http://marklogic.com/transitive";

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

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

(:~
 : Transitively searches up the predicate s->o
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 :)
declare function transitive:transitive-down(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer
) {
  transitive:transitive-down($seeds,$preds,$limit,cts:and-query(()))
};

(:~
 : Traverses up a relationship up subject->object via a predicate
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 :)
declare function transitive:transitive-down(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer,
   $filter as cts:query?
) {
   semi:bfs($seeds, $limit, function($s) { cts:triples($s,$preds,(),(),$filter) ! sem:triple-object(.) })
};

(:~
 : Traverses up a relationship up object->subject via a predicate
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 :)
declare function transitive:transitive-up(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer
) {
   transitive:transitive-up($seeds,$preds,$limit,())
};

(:~
 : Traverses up a relationship up object->subject via a predicate
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 : @param $filter - A cts:query that will be passed as a condition of the relationship
 :)
 declare function transitive:transitive-up(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer,
   $filter as cts:query?
) {
   semi:bfs($seeds, $limit, function($o) { cts:triples((),$preds,$o,(),(),$filter) ! sem:triple-subject(.) })
};

(:~
 : Traverses up a relationship to find all ancestors excluding the $seed values
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 : @param $filter - A cts:query that will be passed as a condition of the relationship
 :)
declare function transitive:ancestors(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer
) {
   transitive:ancestors($seeds,$preds,$limit,())[fn:not((. = $seeds))]
};

(:~
 : Traverses up a relationship to find all ancestors excluding the $seed values
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 : @param $filter - A cts:query that will be passed as a condition of the relationship
 :)
declare function transitive:ancestors(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer,
   $filter as cts:query?
) {
   transitive:transitive-up($seeds,$preds,$limit,$filter)[fn:not((. = $seeds))]
};

(:~
 : Traverses up a relationship to find all ancestors including the $seed values
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 : @param $filter - A cts:query that will be passed as a condition of the relationship
 :)
declare function transitive:ancestors-or-self(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer
) {
   transitive:ancestors-or-self($seeds,$preds,$limit,())
};

(:~
 : Traverses up a relationship to find all ancestors including the $seed values
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 : @param $filter - A cts:query that will be passed as a condition of the relationship
 :)
declare function transitive:ancestors-or-self(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer,
   $filter as cts:query?
) {
 transitive:transitive-up($seeds,$preds,$limit,$filter)
};

(:~
 : Returns all descendant without seeds
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 :)
declare function transitive:descendants(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer
) {
   transitive:descendants($seeds,$preds,$limit,())
};
(:~
 : Returns all descendant without seeds
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 : @param $filter - A cts:query that will be passed as a condition of the relationship
 :)
declare function transitive:descendants(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer,
   $filter as cts:query?
) {
   transitive:transitive-down($seeds,$preds,$limit,$filter)[fn:not((. = $seeds))]
};
(:~
 : Returns all descendant with seed
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 :)
declare function transitive:descendants-or-self(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer
) {
   transitive:descendants-or-self($seeds,$preds,$limit,())
};
(:~
 : Returns all descendant without seeds
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 : @param $filter - A cts:query that will be passed as a condition of the relationship
 :)
declare function transitive:descendants-or-self(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer,
   $filter as cts:query?
) {
   transitive:transitive-down($seeds,$preds,$limit,$filter)
};

(:~
 : Returns all ancestors and descendants from a given node without the seeds
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 :)
declare function transitive:ancestors-descendants(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer
) {(
    transitive:ancestors-descendants($seeds,$preds,$limit,())
)};
(:~
 : Returns all ancestors and descendants from a given node without the seeds
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 : @param $filter - A cts:query that will be passed as a condition of the relationship
 :)
declare function transitive:ancestors-descendants(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer,
   $filter as cts:query?
) {(
  transitive:transitive-up($seeds,$preds,$limit,$filter)[fn:not((. = $seeds))],
  transitive:transitive-down($seeds,$preds,$limit,$filter)[fn:not((. = $seeds))]
)};

(:~
 : Returns all ancestors and descendants from a given node and the seeds
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 :)
declare function transitive:ancestors-descendants-or-self(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer
) {
   transitive:ancestors-descendants-or-self($seeds,$preds,$limit,())
};
(:~
 : Returns all ancestors and descendants and self from a starting seed
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 : @param $filter - A cts:query that will be passed as a condition of the relationship
 :)
declare function transitive:ancestors-descendants-or-self(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer,
   $filter as cts:query?
) {
(
  transitive:transitive-up($seeds,$preds,$limit,$filter)
  transitive:transitive-down($seeds,$preds,$limit,$filter)
)
};

(:~
 : Returns all Roots given a predicate.
 : The logic is that a parent should never be the object of a given subject via a predicate
 : @param $predicates - An IRI Predicate to filter relationships by.
 :)
declare function transitive:roots($predicates as sem:iri) {
   transitive:roots($predicates,(),())
};
(:~
 : Returns all Roots given a predicate.
 : The logic is that a parent should never be the object of a given subject via a predicate
 : @param $predicates - An IRI Predicate to filter relationships by.
 : @param $subject - a base subject if not passed will not bind subject
 :)
 declare function transitive:roots($predicates as sem:iri,$subject as sem:iri?) {
   transitive:roots($predicates,(),())
};
(:~
 : Returns 1 level deep child relationshps
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 :)
declare function transitive:children(
   $seeds as sem:iri*,
   $preds as sem:iri*
) {
   transitive:descendants($seeds,$preds,1,())
};

(:~
 : Returns 1 level deep child relationships
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $query - Predicate Query to filter while traversing
 :)
declare function transitive:children(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $query as cts:query?
) {
   transitive:descendants($seeds,$preds,1,$query)
};

(:~
 : Returns 1 level up ancestor relationships
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 :)
declare function transitive:ancestor(
   $seeds as sem:iri*,
   $preds as sem:iri*
) {
   transitive:ancestor($seeds,$preds,())
};

(:~
 : Returns 1 level up ancestor relationships
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $query - A cts:query to bind to function
 :)
declare function transitive:ancestor(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $query as cts:query?
) {
   transitive:ancestors($seeds,$preds,1,$query)
};

(:~
 : Returns all sibling subjects from a given node.  Logic is lookup 1 level then traverse-down
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 :)
 declare function transitive:siblings(
   $seeds as sem:iri*,
   $preds as sem:iri*
) {
   transitive:siblings($seeds,$preds,())
};

(:~
 :  Returns all sibling subjects from a given node.  Logic is lookup 1 level then traverse-down
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $query - A cts:query to bind to function
 :)
 declare function transitive:siblings(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $query as cts:query?
) {
   let $parents := transitive:ancestor($seeds,$preds,$query)
   return
     transitive:children($parents,$preds,$query)[fn:not((. = $seeds))]
};

(:Transitive Extensions:)
(:~
 : Returns all Roots given a predicate.
 : The logic is that a parent should never be the object of a given subject via a predicate
 : @param $predicates - An IRI Predicate to filter relationships by.
 : @param $subject - a base subject if not passed will not bind subject
 : @param $query - a cts:query to limit scope of roots returned
 :)
declare function transitive:roots(
    $predicates as sem:iri,
    $subject as sem:iri?,
    $query as cts:query?
) {
 sem:sparql-values('select distinct ?subject {
    ?subject ?predicate [] .
    optional {
        ?parent ?predicate ?subject .
    }
    filter(! ?parent)
}',
 map:new((
    map:entry("predicate",$predicates),
    if($subject) then map:entry("subject",$subject) else ()
 )),
 (),
 $query
 ) ! map:get(.,"subject")
};
(:~
 :  Returns a treemap of the structure
 :)
declare function transitive:tree(
  $predicate as sem:iri
) as json:object* {
    let $roots := map:get(transitive:roots($predicate),"subject")
    return
      transitive:traverser($roots,$predicate)
};
(:~
 : Takes a seed subject/predicate and creates a nested tree structure traversing the predicate based on a seed subject.
 :)
declare function transitive:traverser(
    $subject as sem:iri,
    $predicate as sem:iri*
) {
  transitive:traverser($subject,$predicate,())
};

(:~
 : Takes a seed subject/predicate and creates a nested tree structure traversing the predicate based on a seed subject.
 : @param $subject - Starting Subject to traverse
 : @param $predicate - The relationship to use for the traversal
 :)
declare function transitive:traverser(
    $subject as sem:iri,
    $predicate as sem:iri*,
    $query as cts:query?
) {
   transitive:traverser($subject,$predicate,$query,map:map())
};

(:~
 : Takes a seed subject/predicate and creates a nested tree structure traversing the predicate based on a seed subject.
 : @param $subject - Starting Subject to traverse
 : @param $predicate - The relationship to use for the traversal
 : @param $query - A cts:query to constraint all results by
 : @param $property-map - A map:map where the key is the iri and the value can be a label to replace it with.
 :  Options:
 :    map:entry("property",map:map) -  property-map(map:map) is present, the keys will be converted mapped triples.
                                       If a string is specified as value then key  will be the value.
 :    map:entry("recursive",xs:boolean) - Determines if the traversal is recursive
 :    map:entry("maxdepth",xs:integer)  - Determines how deep to traverse before it stops
 :                                       -1 - infinitely
 :                                        0  - Is only the current node
 :                                     * - Any depth level
 :    map:entry("callback",function(*)) - Is a callback applied to each traversed link. The callback assumes the following signature:
 :            function($node,[$options,[depth]]) {}
 :)
declare function transitive:traverser(
    $subject as sem:iri,
    $predicate as sem:iri*,
    $query as cts:query?,
    $options as map:map?
) {
    transitive:traverser-inner($subject,$predicate,$query,$options,0)
};

(:~
 : Transitive Inner wraps traversal library and supports the recursive calls.

 : @param $subject - Is the current subject to traverse
 : @param $predicate - The relationship to use for the traversal
 : @param $query - A cts:query to constraint all results by
 : @param $options - options node as a map:map
 : @param $depth - Is the current depth of the traverser
~:)
declare function transitive:traverser-inner(
    $subject as sem:iri,
    $predicate as sem:iri*,
    $query as cts:query?,
    $options as map:map?,
    $depth as xs:integer
) {
   (:Get Options:)
   let $recursive := (map:get($options,"recursive"),fn:true())[1]
   let $max-depth := (map:get($options,"maxdepth"),-1)[1]
   let $has-depth := if($max-depth eq -1) then fn:true() else if($depth lt $max-depth) then fn:true() else fn:false()
   let $callback  := map:get($options,"callback")
   let $yield     := map:get($options,"yield") eq fn:true()
   (:Setter Vars:)
   let $child := transitive:descendants($subject,$predicate,1)
   let $jso := json:object()
   let $_ := (
       map:put($jso,"subject",$subject),
       map:put($jso,"predicate",$predicate)
   )
   let $properties  :=
     if(fn:exists(map:get($options,"property")))
     then
        let $property-map := map:get($options,"property")
        let $keys := map:keys($property-map) ! sem:iri(.)
        let $triples := cts:triples($subject,$keys)
        return
          for $triple in $triples
          let $predicate := sem:triple-predicate($triple)
          let $label := map:get($property-map,$predicate)[. ne ""]
          let $label := if($label) then $label else $predicate
          let $object := sem:triple-object($triple)
          let $value :=
            typeswitch($object)
            case rdf:langString return fn:concat(fn:data($object),"^^@",rdf:langString-language($object))
            default return $object
          return
            map:put($jso,$label,(map:get($jso,$label),$value))
     else ()
   let $apply :=
        if(fn:exists($callback))
        then
            let $arity := fn:function-arity($callback)
            return
              switch($arity)
                case 1 return $callback($jso)
                case 2 return $callback($jso,$options)
                case 3 return $callback($jso,$options,$depth)
                default return fn:error(xs:QName("CALLBACK-ARITY-MISMATCH"),"No Supported Callback interface with arity",$arity)
        else ()
   let $_ :=
       if($recursive and $has-depth and fn:not($yield))
       then map:put($jso,"nodes",json:to-array($child ! transitive:traverser-inner(.,$predicate,$query,$options,$depth + 1)))
       else ()
   return $jso
};

xquery version "1.0-ml";

module namespace transitive = "http://marklogic.com/transitive";

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

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

(:~
 : Transitively searches up the predicate s->o
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 :)
declare function transitive:transitive-down(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer
) {
  transitive:transitive-down($seeds,$preds,$limit,cts:and-query(()))
};

(:~
 : Traverses up a relationship up subject->object via a predicate
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 :)
declare function transitive:transitive-down(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer,
   $filter as cts:query?
) {
   semi:bfs($seeds, $limit, function($s) { cts:triples($s,$preds,(),(),$filter) ! sem:triple-object(.) })
};

(:~
 : Traverses up a relationship up object->subject via a predicate
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 :)
declare function transitive:transitive-up(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer
) {
   transitive:transitive-up($seeds,$preds,$limit,())
};

(:~
 : Traverses up a relationship up object->subject via a predicate
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 : @param $filter - A cts:query that will be passed as a condition of the relationship
 :)
 declare function transitive:transitive-up(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer,
   $filter as cts:query?
) {
   semi:bfs($seeds, $limit, function($o) { cts:triples((),$preds,$o,(),(),$filter) ! sem:triple-subject(.) })
};

(:~
 : Traverses up a relationship to find all ancestors excluding the $seed values
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 : @param $filter - A cts:query that will be passed as a condition of the relationship
 :)
declare function transitive:ancestors(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer
) {
   transitive:ancestors($seeds,$preds,$limit,())[fn:not((. = $seeds))]
};

(:~
 : Traverses up a relationship to find all ancestors excluding the $seed values
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 : @param $filter - A cts:query that will be passed as a condition of the relationship
 :)
declare function transitive:ancestors(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer,
   $filter as cts:query?
) {
   transitive:transitive-up($seeds,$preds,$limit,$filter)[fn:not((. = $seeds))]
};

(:~
 : Traverses up a relationship to find all ancestors including the $seed values
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 : @param $filter - A cts:query that will be passed as a condition of the relationship
 :)
declare function transitive:ancestors-or-self(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer
) {
   transitive:ancestor-or-self($seeds,$preds,$limit,())
};

(:~
 : Traverses up a relationship to find all ancestors including the $seed values
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 : @param $filter - A cts:query that will be passed as a condition of the relationship
 :)
declare function transitive:ancestors-or-self(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer,
   $filter as cts:query?
) {
 transitive:transitive-up($seeds,$preds,$limit,$filter)
};

(:~
 : Returns all descendant without seeds
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 :)
declare function transitive:descendants(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer
) {
   transitive:descendants($seeds,$preds,$limit,())
};
(:~
 : Returns all descendant without seeds
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 : @param $filter - A cts:query that will be passed as a condition of the relationship
 :)
declare function transitive:descendants(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer,
   $filter as cts:query?
) {
   transitive:transitive-down($seeds,$preds,$limit,$filter)[fn:not((. = $seeds))]
};
(:~
 : Returns all descendant with seed
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 :)
declare function transitive:descendants-or-self(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer
) {
   transitive:descendants-or-self($seeds,$preds,$limit,())
};
(:~
 : Returns all descendant without seeds
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 : @param $filter - A cts:query that will be passed as a condition of the relationship
 :)
declare function transitive:descendants-or-self(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer,
   $filter as cts:query?
) {
   transitive:transitive-down($seeds,$preds,$limit,$filter)
};

(:~
 : Returns all ancestors and descendants from a given node without the seeds
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 :)
declare function transitive:ancestors-descendants(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer
) {(
    transitive:ancestors-descendants($seeds,$preds,$limit,())
)};
(:~
 : Returns all ancestors and descendants from a given node without the seeds
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 : @param $filter - A cts:query that will be passed as a condition of the relationship
 :)
declare function transitive:ancestors-descendants(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer,
   $filter as cts:query?
) {(
  transitive:transitive-up($seeds,$preds,$limit,$filter)[fn:not((. = $seeds))],
  transitive:transitive-down($seeds,$preds,$limit,$filter)[fn:not((. = $seeds))]
)};

(:~
 : Returns all ancestors and descendants from a given node and the seeds
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 :)
declare function transitive:ancestors-descendants-or-self(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer
) {
   transitive:ancestors-descendants-or-self($seeds,$preds,$limit,())
};

(:~
 : Returns all ancestors and descendants from a given node and the seeds
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 : @param $filter - A cts:query that will be passed as a condition of the relationship
 :)
declare function transitive:ancestors-descendants(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $limit as xs:integer,
   $filter as cts:query?
) {(
  transitive:transitive-up($seeds,$preds,$limit,$filter)[fn:not((. = $seeds))],
  $seeds,
  transitive:transitive-down($seeds,$preds,$limit,$filter)[fn:not((. = $seeds))]
)
};

(:~
 : Returns all Roots given a predicate.
 : The logic is that a parent should never be the object of a given subject via a predicate
 : @param $predicates - An IRI Predicate to filter relationships by.
 :)
declare function transitive:roots($predicates as sem:iri) {
   transitive:roots($predicates,(),())
};
(:~
 : Returns all Roots given a predicate.
 : The logic is that a parent should never be the object of a given subject via a predicate
 : @param $predicates - An IRI Predicate to filter relationships by.
 : @param $subject - a base subject if not passed will not bind subject
 :)
 declare function transitive:roots($predicates as sem:iri,$subject as sem:iri?) {
   transitive:roots($predicates,(),())
};
(:~
 : Returns 1 level deep child relationshps
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $limit - The recursive depth or degrees to traverse before stopping.
 :)
declare function transitive:children(
   $seeds as sem:iri*,
   $preds as sem:iri*
) {
   transitive:descendants($seeds,$preds,1,())
};

(:~
 : Returns 1 level deep child relationships
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $query - Predicate Query to filter while traversing
 :)
declare function transitive:children(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $query as cts:query?
) {
   transitive:descendants($seeds,$preds,1,$query)
};

(:~
 : Returns 1 level up ancestor relationships
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 :)
declare function transitive:ancestor(
   $seeds as sem:iri*,
   $preds as sem:iri*
) {
   transitive:ancestor($seeds,$preds,())
};

(:~
 : Returns 1 level up ancestor relationships
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $query - A cts:query to bind to function
 :)
declare function transitive:ancestor(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $query as cts:query?
) {
   transitive:ancestors($seeds,$preds,1,$query)
};

(:~
 : Returns all sibling subjects from a given node.  Logic is lookup 1 level then traverse-down
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 :)
 declare function transitive:siblings(
   $seeds as sem:iri*,
   $preds as sem:iri*
) {
   transitive:siblings($seeds,$preds,())
};

(:~
 :  Returns all sibling subjects from a given node.  Logic is lookup 1 level then traverse-down
 : @param $seeds - The seed subject
 : @param $preds - The seed predicate
 : @param $query - A cts:query to bind to function
 :)
 declare function transitive:siblings(
   $seeds as sem:iri*,
   $preds as sem:iri*,
   $query as cts:query?
) {
   let $parents := transitive:ancestor($seeds,$preds,$query)
   return
     transitive:children($parents,$preds,$query)[fn:not((. = $seeds))]
};

(:Transitive Extensions:)
(:~
 : Returns all Roots given a predicate.
 : The logic is that a parent should never be the object of a given subject via a predicate
 : @param $predicates - An IRI Predicate to filter relationships by.
 : @param $subject - a base subject if not passed will not bind subject
 : @param $query - a cts:query to limit scope of roots returned
 :)
declare function transitive:roots(
    $predicates as sem:iri,
    $subject as sem:iri?,
    $query as cts:query?
) {
 sem:sparql-values('select distinct ?subject {
    ?subject ?predicate [] .
    optional {
        ?parent ?predicate ?subject .
    }
    filter(! ?parent)
}',
 map:new((
    map:entry("predicate",$predicates),
    if($subject) then map:entry("subject",$subject) else ()
 )),
 (),
 $query
 ) ! map:get(.,"subject")
};
(:~
 :  Returns a treemap of the structure
 :)
declare function transitive:tree(
  $predicate as sem:iri
) as json:object* {
    let $roots := map:get(transitive:roots($predicate),"subject")
    return
      transitive:traverser($roots,$predicate)
};
(:~
 : Takes a seed subject/predicate and creates a nested tree structure traversing the predicate based on a seed subject.
 :)
declare function transitive:traverser(
    $subject as sem:iri,
    $predicate as sem:iri*
) {
  transitive:traverser($subject,$predicate,())
};

(:~
 : Takes a seed subject/predicate and creates a nested tree structure traversing the predicate based on a seed subject.
 : @param $subject - Starting Subject to traverse
 : @param $predicate - The relationship to use for the traversal
 :)
declare function transitive:traverser(
    $subject as sem:iri,
    $predicate as sem:iri*,
    $query as cts:query?
) {
   transitive:traverser($subject,$predicate,$query,map:map())
};

(:~
 : Takes a seed subject/predicate and creates a nested tree structure traversing the predicate based on a seed subject.
 : @param $subject - Starting Subject to traverse
 : @param $predicate - The relationship to use for the traversal
 : @param $query - A cts:query to constraint all results by
 : @param $property-map - A map:map where the key is the iri and the value can be a label to replace it with.
 :  Options:
 :    map:entry("property",map:map) -  property-map(map:map) is present, the keys will be converted mapped triples.
                                       If a string is specified as value then key  will be the value.
 :    map:entry("recursive",xs:boolean) - Determines if the traversal is recursive
 :    map:entry("maxdepth",xs:integer)  - Determines how deep to traverse before it stops
 :                                       -1 - infinitely
 :                                        0  - Is only the current node
 :                                     * - Any depth level
 :    map:entry("callback",function(*)) - Is a callback applied to each traversed link. The callback assumes the following signature:
 :            function($node,[$options,[depth]]) {}
 :)
declare function transitive:traverser(
    $subject as sem:iri,
    $predicate as sem:iri*,
    $query as cts:query?,
    $options as map:map?
) {
    transitive:traverser-inner($subject,$predicate,$query,$options,0)
};

(:~
 : Transitive Inner wraps traversal library and supports the recursive calls.

 : @param $subject - Is the current subject to traverse
 : @param $predicate - The relationship to use for the traversal
 : @param $query - A cts:query to constraint all results by
 : @param $options - options node as a map:map
 : @param $depth - Is the current depth of the traverser
~:)
declare function transitive:traverser-inner(
    $subject as sem:iri,
    $predicate as sem:iri*,
    $query as cts:query?,
    $options as map:map?,
    $depth as xs:integer
) {
   (:Get Options:)
   let $recursive := (map:get($options,"recursive"),fn:true())[1]
   let $max-depth := (map:get($options,"maxdepth"),-1)[1]
   let $has-depth := if($max-depth eq -1) then fn:true() else if($depth lt $max-depth) then fn:true() else fn:false()
   let $callback  := map:get($options,"callback")
   let $yield     := map:get($options,"yield") eq fn:true()
   (:Setter Vars:)
   let $child := transitive:descendants($subject,$predicate,1)
   let $jso := json:object()
   let $_ := (
       map:put($jso,"subject",$subject),
       map:put($jso,"predicate",$predicate)
   )
   let $properties  :=
     if(fn:exists(map:get($options,"property")))
     then
        let $property-map := map:get($options,"property")
        let $keys := map:keys($property-map) ! sem:iri(.)
        let $triples := cts:triples($subject,$keys)
        return
          for $triple in $triples
          let $predicate := sem:triple-predicate($triple)
          let $label := map:get($property-map,$predicate)[. ne ""]
          let $label := if($label) then $label else $predicate
          let $object := sem:triple-object($triple)
          let $value :=
            typeswitch($object)
            case rdf:langString return fn:concat(fn:data($object),"^^@",rdf:langString-language($object))
            default return $object
          return
            map:put($jso,$label,(map:get($jso,$label),$value))
     else ()
   let $apply :=
        if(fn:exists($callback))
        then
            let $arity := fn:function-arity($callback)
            return
              switch($arity)
                case 1 return $callback($jso)
                case 2 return $callback($jso,$options)
                case 3 return $callback($jso,$options,$depth)
                default return fn:error(xs:QName("CALLBACK-ARITY-MISMATCH"),"No Supported Callback interface with arity",$arity)
        else ()
   let $_ :=
       if($recursive and $has-depth and fn:not($yield))
       then map:put($jso,"nodes",json:to-array($child ! transitive:traverser-inner(.,$predicate,$query,$options,$depth + 1)))
       else ()
   return $jso
};


updated

updated

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

xquery version "1.0";
(: $Id$ :)

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

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

declare option exist:serialize "media-type=text/xml";

declare function ajax:display-collection($collection as xs:string) as element()* {
    (
        for $child in xdb:get-child-collections($collection) order by $child return
            <collection name="{$child}" path="{concat($collection, '/', $child)}"/>,

        for $child in xdb:get-child-resources($collection) order by $child return
            <resource name="{$child}" path="{concat($collection, '/', $child)}"/>
    )
};

let $collection := request:get-parameter("collection", ())
return
    <ajax-response root="{replace($collection, '/[^/]*$', '', 'mx')}">
    {
        ajax:display-collection($collection)
    }
    </ajax-response>

xquery version "1.0";
(: $Id$ :)

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

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

declare option exist:serialize "media-type=text/xml";

declare function ajax:display-collection($collection as xs:string) as element()* {
    let $c := xdb:collection($collection, "guest", "guest")
    let $parent := util:collection-name($c)
    return (
        for $child in xdb:get-child-collections($collection)
        order by $child
        return
            <collection name="{$child}" path="{concat($parent, '/', $child)}"/>,
        for $child in xdb:get-child-resources($collection)
        order by $child
        return
            <resource name="{$child}" path="{concat($parent, '/', $child)}"/>
    )
};

let $collection := request:get-parameter("collection", ())
return
    <ajax-response root="{replace($collection, '/[^/]*$', '', 'mx')}">
    {
        ajax:display-collection($collection)
    }
    </ajax-response>