fixed issue with pollUdpatedServices

fixed issue with pollUdpatedServices

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

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

declare updating
  %rest:path("/CSD/registerService/init")
  function page:init()
{
  (
    csd_lsc:init_cache_meta($csd_webconf:db)
    ,csd_psd:init($csd_webconf:db)
    ,csd_webui:redirect_out("CSD/pollService")
  )
};

declare updating
  %rest:path("/CSD/registerService/named/{$name}")
  %output:method("xhtml")
  %rest:GET
  function page:register_named($name)
{

  (
    let $sample := $csd_webconf:remote_services//serviceDirectory[@name=$name]
    return if (exists($sample)) then
      csd_psd:register_service($csd_webconf:db,$name,text{$sample/@url},$sample/credentials)
    else ()
  ,
  csd_webui:redirect_out("CSD/pollService")
  )
};

declare updating
  %rest:path("/CSD/registerService/basic_auth")
  %output:method("xhtml")
  %rest:query-param("name", "{$name}")
  %rest:query-param("url", "{$url}")
  %rest:query-param("password", "{$password}")
  %rest:query-param("username", "{$username}")
  %rest:GET
  function page:register_basic_auth($name,$url,$username,$password)
{

  (
    let $credentials := <credentials type="basic_auth" username="{$username}" password="{$password}"/>
    return csd_psd:register_service($csd_webconf:db,$name,$url,$credentials)
      ,
  csd_webui:redirect_out("CSD/pollService")
  )

};

declare updating
  %rest:path("/CSD/registerService/basic_auth/{$name}")
  %output:method("xhtml")
  %rest:query-param("url", "{$url}")
  %rest:query-param("password", "{$password}")
  %rest:query-param("username", "{$username}")
  %rest:GET
  function page:update_basic_auth($name,$url,$username,$password)
{

  (
    let $credentials := <credentials type="basic_auth" username="{$username}" password="{$password}"/>
    return csd_psd:register_service($csd_webconf:db,$name,$url,$credentials)
      ,
  csd_webui:redirect_out("CSD/pollService")
  )

};

declare
  %rest:path("/CSD/pollService/cache_meta")
  %rest:GET
  function page:get_cache_meta()
{
  csd_lsc:get_cache_data($csd_webconf:db,())
};

declare
  %rest:path("/CSD/pollService/directory/{$name}")
  %rest:GET
  %output:method("xhtml")
  function page:get_service_menu($name)
{
  let $response :=
{$name}
{page:service_menu($name) }
  return csd_webui:nocache(csd_webui:wrapper($response))
};

declare
  %rest:path("/CSD/pollService/directory/{$name}/cache_meta")
  %rest:GET
  function page:get_service_cache_meta($name)
{
  csd_lsc:get_cache_data($csd_webconf:db,$name)
};

declare updating
  %rest:path("/CSD/pollService/directory/{$name}/create_cache")
  %rest:GET
  function page:create_cache($name)
{

  (
    if (csd_lsc:directory_exists($csd_webconf:db,$name))
    then csd_lsc:empty_cache($csd_webconf:db,$name)
    else csd_dm:empty($csd_webconf:db,$name)
  ,
  csd_webui:redirect_out("CSD/pollService")
  )

};

declare updating
  %rest:path("/CSD/pollService/directory/{$name}/drop_cache_meta")
  %rest:GET
  function page:drop_service_cache_meta($name)
{
  (
  csd_lsc:drop_cache_data($csd_webconf:db,$name)
  ,
  csd_webui:redirect_out("CSD/pollService")
  )

};

declare
  %rest:path("/CSD/pollService/directory/{$name}/get_cache")
  %rest:GET
  function page:get_cache($name)
{
 csd_lsc:get_cache($csd_webconf:db,$name)
};

declare updating
  %rest:path("/CSD/pollService/directory/{$name}/empty_cache")
  %rest:GET
  function page:empty_cache($name)
{
  (
  csd_lsc:empty_cache($csd_webconf:db,$name)
  ,
  csd_webui:redirect_out("CSD/pollService")
  )

};

declare updating
  %rest:path("/CSD/pollService/directory/{$name}/update_cache")
  %rest:GET
  function page:update_cache($name)
{
(
  csd_lsc:update_cache($csd_webconf:db,$name)   ,
  csd_webui:redirect_out("CSD/pollService")
)

};

declare
  %rest:path("/CSD/pollService/directory/{$name}/show_update_cache")
  %rest:GET
  function page:show_update_cache($name)
{

  let $db := $csd_webconf:db
  let $mtime :=  csd_lsc:get_service_directory_mtime($db,$name)
  let $soap := csd_psd:generate_soap_request($db,$name,$mtime)
  let $result := http:send-request($soap)
  return <r>{$result}</r><s>{$soap}</s>

};

declare
  %rest:path("/CSD/pollService/{$name}")
  %output:method("xhtml")
  %rest:GET
  function page:display_service_menu($name)
{
  let $response :=

	{page:service_menu($name)}

  return  csd_webui:nocache(page:wrapper($response))
};

declare
  %rest:path("/CSD/pollService/{$name}/get")
  %rest:query-param("mtime", "{$mtime}")
  %rest:GET
  function page:poll_service($name,$mtime)
{
if ($mtime) then
 csd_psd:poll_service_directory_soap_response($csd_webconf:db,$name,$mtime)
else
 csd_psd:poll_service_directory_soap_response($csd_webconf:db,$name,csd_lsc:get_service_directory_mtime($csd_webconf:db,$name))
};

declare
  %rest:path("/CSD/pollService/{$name}/get_csd")
  %rest:query-param("mtime", "{$mtime}")
  %rest:GET
  function page:poll_service_csd($name,$mtime)
{
if ($mtime) then
 csd_psd:poll_service_directory($csd_webconf:db,$name,$mtime)
else
 csd_psd:poll_service_directory($csd_webconf:db,$name,csd_lsc:get_service_directory_mtime($csd_webconf:db,$name))
};

declare
  %rest:path("/CSD/pollService/{$name}/get_soap")
  %rest:query-param("mtime", "{$mtime}")
  %rest:GET
  function page:poll_service_soap($name,$mtime)
{
 let $url := csd_psd:get_service_directory_url($csd_webconf:db,$name)
 return (
 <rest:response>
   <http:response status="200" >
     <http:header name="Content-Type" value="application/soap+xml"/>
     <http:header name="Content-Disposition"  value="inline; filename=soap_query_updated_services_{$name}"/>
   </http:response>
   </rest:response>
   ,
   if ($mtime) then
     csd_qus:create_last_update_request($url,$mtime)
   else
     csd_qus:create_last_update_request($url,csd_lsc:get_service_directory_mtime($csd_webconf:db,$name))
 )

};

declare function page:wrapper($response) {
  let $headers :=
  (<link rel="stylesheet" type="text/css" media="screen"   href="{csd_webui:generateURL('static/bootstrap-datetimepicker/css/bootstrap-datetimepicker.min.css')}"/>
  ,
  )
  return csd_webui:wrapper($response,$headers)
};

declare
  %rest:path("/CSD/pollService")
  %rest:GET
  %output:method("xhtml")
  function page:poll_service_list()
{

if (not(csd_psd:dm_exists($csd_webconf:db))) then
   csd_webui:redirect("CSD/registerService/init")
 else
   let $services := csd_psd:registered_directories($csd_webconf:db)
   let $unreg_services :=
     for $sample in  $csd_webconf:remote_services//serviceDirectory
     where not(csd_psd:is_registered($csd_webconf:db,$sample/text{@name}))
     return  $sample
    let $response :=

Add New Service (Basic Auth)

	 <form method='get' action="{csd_webui:generateURL('/CSD/registerService/basic_auth')}">

 Name<input class='pull-right'  size="35"      name='name' type="text" value=""/>

URL<input  class='pull-right' size="35"     name='url' type="text" value=""/>

User Name<input  class='pull-right' size="35"     name='username' type="text" value=""/>

Password<input  class='pull-right' size="35"     name='password' type="text" value=""/>

	   <input type='submit' />
	 </form>

	 {
	   if (count($unreg_services) > 0) then

Add New Default Service

	       {for $sample in $unreg_services
	       let $name := $sample/text{@name}
	       return

		 Register {$name}

	       }

	 else ()
}

Global Operations

 Get all cache Meta-Data

Registered Service Directories

	 {if (count($services) = 0)
	 then
No Services Registered

       else

	 {for $name in $services
	 let $mtime := csd_lsc:get_service_directory_mtime($csd_webconf:db,$name)
	 order by $name
	 return

	   {$name} last cached on {$mtime}

	 }

	 }

Update Service (Basic Auth)

	 {
	   for $name in $services
	   let $url := csd_psd:get_service_directory_url($csd_webconf:db,$name)
	   return

{$name}

	       <form method='get' action="{csd_webui:generateURL(('/CSD/registerService/basic_auth',$name))}">

URL<input  class='pull-right' size="35"     name='url' type="text" value="{$url}"/>

User Name<input  class='pull-right' size="35"     name='username' type="text" value=""/>

Password<input  class='pull-right' size="35"     name='password' type="text" value=""/>

		 <input type='submit' />
	       </form>

	 }

  return csd_webui:nocache(page:wrapper($response))

};

declare function page:service_menu($name) {
  let $url := csd_psd:get_service_directory_url($csd_webconf:db,$name)
  let $mtime := csd_lsc:get_service_directory_mtime($csd_webconf:db,$name)
  return

{$url}

    modified: {$mtime}

Caching
{csd_lsc:get_document_name($name)}

    {if (not(csd_lsc:directory_exists($csd_webconf:db,$name))) then
      (

Create cache of {$name}

      )
  else
    (

Empty local cache of {$name}
,

Get local cache  of {$name}
,

      Update local cache  of {$name}

	WARNING:An InfoMan trying to cache its own service directory will result in a deadlock.  see this issue

,

Get cache Meta Data  for {$name}
,

Drop cache Meta Data  of {$name}

  )
    }

Testing

 Query  {$name} for Updated Services using stored last modified time (SOAP result)

 Query  {$name} for Updated Services using stored last modified time (CSD result)

 Get {$name}'s Soap Query for Updated Services Request using stored last modified time

    Query {$name} for Updated Services by time
    <form method='get' action="{csd_webui:generateURL(('/CSD/pollService',$name,'get'))}">
      <input  size="35" id="datetimepicker_{$name}"    name='mtime' type="text" value="{$mtime}"/>
      <input type='submit' />
    </form>

    Get {$name}'s SOAP reuest for Query for Updated Services by time
    <form method='get' action="{csd_webui:generateURL(('/CSD/pollService',concat('soap_query_updated_services_',$name)))}">
      <input  size="35" id="soap_datetimepicker_{$name}"  name='mtime' type="text" value="{$mtime}"/>
      <input type='submit' />
    </form>

  To test submission on your machine you can do:

curl --header "content-type: application/soap+xml" --data "@soap_query_updated_services_{$name}.xml" {$url}

  where soap_updated_services_{$name}.xml is  the downloaded soap request document.  Add authorization parameters as neccesary.

};

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

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

declare updating
  %rest:path("/CSD/registerService/init")
  function page:init()
{
  (
    csd_lsc:init_cache_meta($csd_webconf:db)
    ,csd_psd:init($csd_webconf:db)
    ,csd_webui:redirect_out("CSD/pollService")
  )
};

declare updating
  %rest:path("/CSD/registerService/named/{$name}")
  %output:method("xhtml")
  %rest:GET
  function page:register_named($name)
{

  (
    let $sample := $csd_webconf:remote_services//serviceDirectory[@name=$name]
    return if (exists($sample)) then
      csd_psd:register_service($csd_webconf:db,$name,text{$sample/@url},$sample/credentials)
    else ()
  ,
  csd_webui:redirect_out("CSD/pollService")
  )
};

declare updating
  %rest:path("/CSD/registerService/basic_auth")
  %output:method("xhtml")
  %rest:query-param("name", "{$name}")
  %rest:query-param("url", "{$url}")
  %rest:query-param("password", "{$password}")
  %rest:query-param("username", "{$username}")
  %rest:GET
  function page:register_basic_auth($name,$url,$username,$password)
{

  (
    let $credentials := <credentials type="basic_auth" username="{$username}" password="{$password}"/>
    return csd_psd:register_service($csd_webconf:db,$name,$url,$credentials)
      ,
  csd_webui:redirect_out("CSD/pollService")
  )

};

declare updating
  %rest:path("/CSD/registerService/basic_auth/{$name}")
  %output:method("xhtml")
  %rest:query-param("url", "{$url}")
  %rest:query-param("password", "{$password}")
  %rest:query-param("username", "{$username}")
  %rest:GET
  function page:update_basic_auth($name,$url,$username,$password)
{

  (
    let $credentials := <credentials type="basic_auth" username="{$username}" password="{$password}"/>
    return csd_psd:register_service($csd_webconf:db,$name,$url,$credentials)
      ,
  csd_webui:redirect_out("CSD/pollService")
  )

};

declare
  %rest:path("/CSD/pollService/cache_meta")
  %rest:GET
  function page:get_cache_meta()
{
  csd_lsc:get_cache_data($csd_webconf:db,())
};

declare
  %rest:path("/CSD/pollService/directory/{$name}")
  %rest:GET
  %output:method("xhtml")
  function page:get_service_menu($name)
{
  let $response :=
{$name}
{page:service_menu($name) }
  return csd_webui:nocache(csd_webui:wrapper($response))
};

declare
  %rest:path("/CSD/pollService/directory/{$name}/cache_meta")
  %rest:GET
  function page:get_service_cache_meta($name)
{
  csd_lsc:get_cache_data($csd_webconf:db,$name)
};

declare updating
  %rest:path("/CSD/pollService/directory/{$name}/create_cache")
  %rest:GET
  function page:create_cache($name)
{

  (
    if (csd_lsc:directory_exists($csd_webconf:db,$name))
    then csd_lsc:empty_cache($csd_webconf:db,$name)
    else csd_dm:empty($csd_webconf:db,$name)
  ,
  csd_webui:redirect_out("CSD/pollService")
  )

};

declare updating
  %rest:path("/CSD/pollService/directory/{$name}/drop_cache_meta")
  %rest:GET
  function page:drop_service_cache_meta($name)
{
  (
  csd_lsc:drop_cache_data($csd_webconf:db,$name)
  ,
  csd_webui:redirect_out("CSD/pollService")
  )

};

declare
  %rest:path("/CSD/pollService/directory/{$name}/get_cache")
  %rest:GET
  function page:get_cache($name)
{
 csd_lsc:get_cache($csd_webconf:db,$name)
};

declare updating
  %rest:path("/CSD/pollService/directory/{$name}/empty_cache")
  %rest:GET
  function page:empty_cache($name)
{
  (
  csd_lsc:empty_cache($csd_webconf:db,$name)
  ,
  csd_webui:redirect_out("CSD/pollService")
  )

};

declare updating
  %rest:path("/CSD/pollService/directory/{$name}/update_cache")
  %rest:GET
  function page:update_cache($name)
{
(
  csd_lsc:update_cache($csd_webconf:db,$name)   ,
  csd_webui:redirect_out("CSD/pollService")
)

};

declare
  %rest:path("/CSD/pollService/directory/{$name}/show_update_cache")
  %rest:GET
  function page:show_update_cache($name)
{

  let $db := $csd_webconf:db
  let $mtime :=  csd_lsc:get_service_directory_mtime($db,$name)
  let $soap := csd_psd:generate_soap_request($db,$name,$mtime)
  let $result := http:send-request($soap)
  return <r>{$result}</r><s>{$soap}</s>

};

declare
  %rest:path("/CSD/pollService/{$name}")
  %output:method("xhtml")
  %rest:GET
  function page:display_service_menu($name)
{
  let $response :=

	{page:service_menu($name)}

  return  csd_webui:nocache(page:wrapper($response))
};

declare
  %rest:path("/CSD/pollService/{$name}/get")
  %rest:query-param("mtime", "{$mtime}")
  %rest:GET
  function page:poll_service($name,$mtime)
{
if ($mtime) then
 csd_psd:poll_service_directory_soap_response($csd_webconf:db,$name,$mtime)
else
 csd_psd:poll_service_directory_soap_response($csd_webconf:db,$name,csd_lsc:get_service_directory_mtime($csd_webconf:db,$name))
};

declare
  %rest:path("/CSD/pollService/{$name}/get_csd")
  %rest:query-param("mtime", "{$mtime}")
  %rest:GET
  function page:poll_service_csd($name,$mtime)
{
if ($mtime) then
 csd_psd:poll_service_directory($csd_webconf:db,$name,$mtime)
else
 csd_psd:poll_service_directory($csd_webconf:db,$name,csd_lsc:get_service_directory_mtime($csd_webconf:db,$name))
};

declare
  %rest:path("/CSD/pollService/{$name}/get_soap")
  %rest:query-param("mtime", "{$mtime}")
  %rest:GET
  function page:poll_service_soap($name,$mtime)
{
 let $url := csd_psd:get_service_directory_url($csd_webconf:db,$name)
 return (
 <rest:response>
   <http:response status="200" >
     <http:header name="Content-Type" value="application/soap+xml"/>
     <http:header name="Content-Disposition"  value="inline; filename=soap_query_updated_services_{$name}"/>
   </http:response>
   </rest:response>
   ,
   if ($mtime) then
     csd_qus:create_last_update_request($url,$mtime)
   else
     csd_qus:create_last_update_request($url,csd_lsc:get_service_directory_mtime($csd_webconf:db,$name))
 )

};

declare function page:wrapper($response) {
  let $headers :=
  (<link rel="stylesheet" type="text/css" media="screen"   href="{csd_webui:generateURL('static/bootstrap-datetimepicker/css/bootstrap-datetimepicker.min.css')}"/>
  ,
  )
  return csd_webui:wrapper($response,$headers)
};

declare
  %rest:path("/CSD/pollService")
  %rest:GET
  %output:method("xhtml")
  function page:poll_service_list()
{

if (not(csd_psd:dm_exists($csd_webconf:db))) then
   csd_webui:redirect("CSD/registerService/init")
 else
   let $services := csd_psd:registered_directories($csd_webconf:db)
   let $unreg_services :=
     for $sample in  $csd_webconf:remote_services//serviceDirectory
     where not(csd_psd:is_registered($csd_webconf:db,$sample/text{@name}))
     return  $sample
    let $response :=

Add New Service (Basic Auth)

	 <form method='get' action="{csd_webui:generateURL('/CSD/registerService/basic_auth')}">

 Name<input class='pull-right'  size="35"      name='name' type="text" value=""/>

URL<input  class='pull-right' size="35"     name='url' type="text" value=""/>

User Name<input  class='pull-right' size="35"     name='username' type="text" value=""/>

Password<input  class='pull-right' size="35"     name='password' type="text" value=""/>

	   <input type='submit' />
	 </form>

	 {
	   if (count($unreg_services) > 0) then

Add New Default Service

	       {for $sample in $unreg_services
	       let $name := $sample/text{@name}
	       return

		 Register {$name}

	       }

	 else ()
}

Global Operations

 Get all cache Meta-Data

Registered Service Directories

	 {if (count($services) = 0)
	 then
No Services Registered

       else

	 {for $name in $services
	 let $mtime := csd_lsc:get_service_directory_mtime($csd_webconf:db,$name)
	 order by $name
	 return

	   {$name} last cached on {$mtime}

	 }

	 }

Update Service (Basic Auth)

	 {
	   for $name in $services
	   let $url := csd_psd:get_service_directory_url($csd_webconf:db,$name)
	   return

{$name}

	       <form method='get' action="{csd_webui:generateURL(('/CSD/registerService/basic_auth',$name))}">

URL<input  class='pull-right' size="35"     name='url' type="text" value="{$url}"/>

User Name<input  class='pull-right' size="35"     name='username' type="text" value=""/>

Password<input  class='pull-right' size="35"     name='password' type="text" value=""/>

		 <input type='submit' />
	       </form>

	 }

  return csd_webui:nocache(page:wrapper($response))

};

declare function page:service_menu($name) {
  let $url := csd_psd:get_service_directory_url($csd_webconf:db,$name)
  let $mtime := csd_lsc:get_service_directory_mtime($csd_webconf:db,$name)
  return

{$url}

    modified: {$mtime}

Caching
{csd_lsc:get_document_name($name)}

    {if (not(csd_lsc:directory_exists($csd_webconf:db,$name))) then
      (

Create cache of {$name}

      )
  else
    (

Empty local cache of {$name}
,

Get local cache  of {$name}
,

      Update local cache  of {$name}

	WARNING:An InfoMan trying to cache its own service directory will result in a deadlock.  see this issue

,

Get cache Meta Data  for {$name}
,

Drop cache Meta Data  of {$name}

  )
    }

Testing

 Query  {$name} for Updated Services using stored last modified time (SOAP result)

 Query  {$name} for Updated Services using stored last modified time (CSD result)

 Get {$name}'s Soap Query for Updated Services Request using stored last modified time

    Query {$name} for Updated Services by time
    <form method='get' action="{csd_webui:generateURL(('/CSD/pollService,$name,'get'))}">
      <input  size="35" id="datetimepicker_{$name}"    name='mtime' type="text" value="{$mtime}"/>
      <input type='submit' />
    </form>

    Get {$name}'s SOAP reuest for Query for Updated Services by time
    <form method='get' action="{csd_webui:generateURL(('/CSD/pollService',concat('soap_query_updated_services_',$name)))}">
      <input  size="35" id="soap_datetimepicker_{$name}"  name='mtime' type="text" value="{$mtime}"/>
      <input type='submit' />
    </form>

  To test submission on your machine you can do:

curl --header "content-type: application/soap+xml" --data "@soap_query_updated_services_{$name}.xml" {$url}

  where soap_updated_services_{$name}.xml is  the downloaded soap request document.  Add authorization parameters as neccesary.

};


[bugfix] Fixed suggestions: util:index-keys-by-qname needs context.

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

xquery version "1.0";

declare namespace mods="http://www.loc.gov/mods/v3";

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

declare variable $local:COLLECTION := '/db';

declare variable $local:FIELDS :=
	<fields>
		<field name="Title">mods:titleInfo</field>
		<field name="Author">mods:name</field>
	</fields>;

declare function local:key($key, $options) {
    concat('"', $key, '"')
};

let $term := request:get-parameter("term", ())
let $field := request:get-parameter("field", "All")
let $qnames :=
    if ($field eq "All") then
        for $field in $local:FIELDS/field return xs:QName($field/string())
    else
        xs:QName($local:FIELDS/field[@name = $field]/string())
let $callback := util:function(xs:QName("local:key"), 2)
return
    concat("[",
        string-join(
            collection($local:COLLECTION)/util:index-keys-by-qname($qnames, $term, $callback, 20, "lucene-index"),
            ', '
        ),
        "]")

xquery version "1.0";

declare namespace mods="http://www.loc.gov/mods/v3";

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

declare variable $local:COLLECTION := "collection('/db')//";

declare variable $local:FIELDS :=
	<fields>
		<field name="Title">mods:titleInfo</field>
		<field name="Author">mods:name</field>
	</fields>;

declare function local:key($key, $options) {
    concat('"', $key, '"')
};

let $term := request:get-parameter("term", ())
let $field := request:get-parameter("field", "All")
let $qnames :=
    if ($field eq "All") then
        for $field in $local:FIELDS/field return xs:QName($field/string())
    else
        xs:QName($local:FIELDS/field[@name = $field]/string())
let $callback := util:function(xs:QName("local:key"), 2)
return
    concat("[",
        string-join(
            util:index-keys-by-qname($qnames, $term, $callback, 20, "lucene-index"),
            ', '
        ),
        "]")


spot edits to date arithmetic with user-defined functions example

xquery version "3.1";
declare namespace ebb="http://newtfire.org";
declare variable $rocketColl := collection('/db/rocket/');
(: ebb: This script introduces you to user-defined functions in XQuery.
These can be useful for taking values from your XQuery variables and performing a conversion, as we're doing here.
Since the Rocket Launches project has multiple attributes encoding launch dates and landing dates in the same xs:dateTime format,
and since they work with the xs:duration datatype too, for coding how long a mission lasted,
we can work with these data to do "date arithmetic" to make simple graphs and charts if we can convert it to a simple decimal notation.
Let's start reading this by skipping past the section I've marked off with asterisks as USER-DEFINED FUNCTIONS, and come back to it :)

(: **************** USER-DEFINED FUNCTIONS **************************:)
(: CONVERT DATETIME to DECIMAL :)
(: ebb :This user-defined function will unpack the date components from an input xs:dateTime datatype.
We will first extract the year from the datatype with year-from-dateTime(),
and then use format-dateTime() to return a 'picture string' that will give us the date's numerical position in the year.
We then divide that date number by 365 (since most years have 365 days).
This will give us a decimal format we can use in making charts and graphs. :)
declare function ebb:dateDecimalConverter($dT as xs:dateTime)
as xs:decimal?
{
let $year := year-from-dateTime($dT) ! xs:integer(.)
let $dayInYear := format-dateTime($dT, '[d]') ! xs:integer(.)
let $decimalDay := $dayInYear div 365
return $year + $decimalDay
};
(: CONVERT DURATION TO DECIMAL :)
(: ebb: The next user-defined function will convert the xs:duration datatype into a decimal value based on number of days.
 : So if we input a duration indicating 1 day, 6 hours, and 0 minutes, we should return 1.25 from this function.
 : Here's what we're calculating: There are 24 hours in a day. (Divide the H portion by 24) and add it to the days.
 : There are 60 minutes in an hour. (Divide the M portion by 60 * 24) and add it to hours.
 : There are 60 seconds in a minute (Divide the S portion by 60 * 60 * 24) and add it to minutes and hours
 : :)
declare function ebb:durationConverter($d as xs:integer, $h as xs:integer, $m as xs:integer, $s as xs:integer?)
as xs:decimal?
{
let $TDec := $h div 24 + $m div (60 * 24) + $s div (60 * 60 * 24)
return $d + $TDec
};
(: *******************END USER-DEFINED FUNCTIONS ********************** :)

let $launchDateTimes := $rocketColl//launch/@sDateTime
for $l in $launchDateTimes
(: To do date arithmetic, take a look at these functions: https://www.w3.org/TR/xpath-functions-31/#dates-times
 : We'll write a user-defined function to convert this datatype into a decimal notation. :)
let $lDec := ebb:dateDecimalConverter($l)
let $m := $rocketColl//launch[@sDateTime = $l]/preceding-sibling::sts
let $mID := $m  ! tokenize(., ':')[1]

let $duration := $m/following-sibling::duration/@time
(: ebb: To do duration arithmetic, start by looking at the functions here: https://www.w3.org/TR/xpath-functions-31/#durations
 : Let's try representing durations in terms of days with a decimal.
 : We'll write a user-defined function to convert hours, minutes, and seconds into a fraction of the day. :)
let $durDays := days-from-duration($duration)
let $durHours := hours-from-duration($duration)
let $durMins := minutes-from-duration($duration)
let $durSecs := seconds-from-duration($duration)
(: Now in line 43, we send our variables to our user-defined function for turning date datatypes into decimal values. :)
let $durDayDec := ebb:durationConverter($durDays, $durHours, $durMins, $durSecs)

order by $lDec
return concat('Launch Date: ', $l, ', mission: ', $mID, ': This Launch Decimal Date: ', $lDec,
': Duration: ', $duration, ': Decimal Notation:', $durDayDec)


:green_heart: Fix warning.

:green_heart: Fix warning.

jsoniq version "1.0";
(:
 : Copyright 2013 28msec Inc.
 :)

(:~
 :
This module provides functions for storing, retrieving, and modifying
 : concept maps. Concept maps can be used in BizQL queries.

 :
 :
A concept map is a network of concepts that can be contained in a report schema.
 : It maps "virtual" concepts to reported concepts, which allows comparison across
 : archives that use different vocabularies (so-called extension facts).

 :
 :
With this module, you can retrieve the concept map associated with each report
 : schema. You can also query for facts by making implicitly use of the mapping.

 :
 : @author Charles Hoffman
 : @author Matthias Brantner
 : @author Dennis Knochenwefel
 : @author Ghislain Fourny
 :
 :)
module namespace concept-maps = "http://28.io/modules/xbrl/concept-maps";

import module namespace networks = "http://28.io/modules/xbrl/networks";
import module namespace report-schemas = "http://28.io/modules/xbrl/report-schemas";

declare namespace ver = "http://zorba.io/options/versioning";
declare option ver:module-version "1.0";

(:~
 : Joker for all archives or all concepts.
 :)
declare variable $concept-maps:ALL_OF_THEM as boolean := true;

(:~
 :
Retrieves all concept maps.

 :
 : @return all concept maps.
 :)
declare function concept-maps:concept-maps() as object*
{
  networks:networks-for-components-and-short-names(report-schemas:report-schemas(), "ConceptMap")
};

(:~
 :
Return the concept maps from the given report schemas.

 :
 : @param $rid the schemas containing the maps, or their RIDs (ConceptMap networks).
 :
 : @return the concept maps from the report schemas.
 :)
declare function concept-maps:concept-maps($report-schemas-or-ids as item*)
as object*
{
  networks:networks-for-components-and-short-names(
    report-schemas:report-schemas($report-schemas-or-ids), "ConceptMap")
};

jsoniq version "1.0";
(:
 : Copyright 2013 28msec Inc.
 :)

(:~
 :
This module provides functions for storing, retrieving, and modifying
 : concept maps. Concept maps can be used in BizQL queries.

 :
 :
A concept map is a network of concepts that can be contained in a report schema.
 : It maps "virtual" concepts to reported concepts, which allows comparison across
 : archives that use different vocabularies (so-called extension facts).

 :
 :
With this module, you can retrieve the concept map associated with each report
 : schema. You can also query for facts by making implicitly use of the mapping.

 :
 : @author Charles Hoffman
 : @author Matthias Brantner
 : @author Dennis Knochenwefel
 : @author Ghislain Fourny
 :
 :)
module namespace concept-maps = "http://28.io/modules/xbrl/concept-maps";

import module namespace archives = "http://28.io/modules/xbrl/archives";
import module namespace facts = "http://28.io/modules/xbrl/facts";
import module namespace networks = "http://28.io/modules/xbrl/networks";
import module namespace report-schemas = "http://28.io/modules/xbrl/report-schemas";

declare namespace ver = "http://zorba.io/options/versioning";
declare option ver:module-version "1.0";

(:~
 : Joker for all archives or all concepts.
 :)
declare variable $concept-maps:ALL_OF_THEM as boolean := true;

(:~
 :
Retrieves all concept maps.

 :
 : @return all concept maps.
 :)
declare function concept-maps:concept-maps() as object*
{
  networks:networks-for-components-and-short-names(report-schemas:report-schemas(), "ConceptMap")
};

(:~
 :
Return the concept maps from the given report schemas.

 :
 : @param $rid the schemas containing the maps, or their RIDs (ConceptMap networks).
 :
 : @return the concept maps from the report schemas.
 :)
declare function concept-maps:concept-maps($report-schemas-or-ids as item*)
as object*
{
  networks:networks-for-components-and-short-names(
    report-schemas:report-schemas($report-schemas-or-ids), "ConceptMap")
};


Rename xf:environment xf:match-environment

xquery version "3.0";

(:~
 : Origami templating.
 :
 : Requires Basex 8.0 20141221 or later.
 :
 : @version 0.4
 : @author Marc van Grootel
 : @see https://github.com/xokomola/origami
 :)

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

(:~
 : Load an HTML resource.
 :)
declare function xf:html-resource($url-or-path) {
    if (starts-with($url-or-path,'http:/')) then
        xf:fetch-html($url-or-path)
    else
        xf:parse-html($url-or-path)
};

(:~
 : Load an XML resource.
 :)
declare function xf:xml-resource($url-or-path) {
    doc($url-or-path)
};

(:~
 : Load a plain text resource.
 :)
declare function xf:text-resource($url-or-path) {
    unparsed-text($url-or-path)
};

(:~
 : Fetch and parse HTML given a URL.
 :)
declare function xf:fetch-html($url) {
    html:parse(fetch:binary($url))
};

(:~
 : Parse HTML from a filesystem path.
 :)
declare function xf:parse-html($path) {
    html:parse(file:read-binary($path))
};

(:~
 : Returns a template function.
 :)
declare function xf:template($template as item()*, $selector as array(*)?, $model as item()*)
    as function(*) {
    let $at := if ($selector instance of array(*)) then xf:at($selector) else function($nodes) { $nodes }
    return
        typeswitch ($model)
        (: test array first because it is also a function :)
        case array(*)*
        return
            function() as item()* {
                $template => $at() => xf:transform($model)
            }
        case function(*)
        return
            switch (function-arity($model))
            case 0
            return
                function() as item()* {
                    $template => $at() => xf:transform($model)
                }
            case 1
            return
                function($arg1 as item()?) as item()* {
                    $template => $at() => xf:transform(apply($model, [$arg1]))
                }
            case 2
            return
                function($arg1 as item()?, $arg2 as item()?) as item()* {
                    $template => $at() => xf:transform(apply($model, [$arg1, $arg2]))
                }
            case 3
            return
                function($arg1 as item()?, $arg2 as item()?, $arg3 as item()?) as item()* {
                    $template => $at() => xf:transform(apply($model, [$arg1, $arg2, $arg3]))
                }
            (: max arity-4 supported :)
            case 4
            return
                function($arg1 as item()?, $arg2 as item()?, $arg3 as item()?, $arg4 as item()?) as item()* {
                    $template => $at() => xf:transform(apply($model, [$arg1, $arg2, $arg3, $arg4]))
                }
            default
            return
                error(xf:ArityNotSupportedError, 'A model function cannot have more than 4 arguments')

        case empty-sequence()
        return
            function() as item()* {
                $template => $at()
            }
        default
        return
            error(xf:InvalidModelError, 'This model cannot be used')
};

(:~
 : Apply `$template` to template function.
 :)
declare function xf:template($template as item(), $model as item()*)
    as function(*) {
    xf:template($template, (), $model)
};

(:~
 : Template identity transform.
 :)
declare function xf:template($template as item())
    as function(*) {
    xf:template($template, (), ())
};

(:~
 : Returns a Transformer function.
 :)
declare function xf:transform($rules as array(*)*)
    as function(item()*) as item()* {
    let $rules :=
        for $rule in $rules
            return xf:match($rule)
    return
        function($nodes as item()*) as item()* {
            xf:apply-nodes(
                $nodes,
                (),
                $rules)
        }
};

(:~
 : Transform input, using the specified rules.
 :)
declare function xf:transform($nodes as item()*, $rules as array(*)*)
    as item()* {
    xf:transform($rules)($nodes)
};

(:~
 : Identity transformer.
 :)
declare function xf:transform() { xf:transform(()) };

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

(:~
 : Extracts nodes from input, using the specified rules.
 :)
declare function xf:extract($nodes as item()*, $rules as array(*)*)
    as item()* {
    xf:extract($rules)($nodes)
};

(:~
 : Returns an extractor function that returns selected nodes,
 : only innermost, in document order and duplicates eliminitated.
 :)
declare function xf:extract-inner($rules as array(*)*)
    as function(item()*) as item()* {
    let $rules :=
        for $rule in $rules
            return
                xf:at($rule)
    return
        function($nodes as item()*) as item()* {
            innermost(
                for $rule in $rules
                    return $rule($nodes)
            )
        }
};

(:~
 : Apply extractor rules to `$nodes` and return the innermost nodes.
 :)
declare function xf:extract-inner($nodes as item()*, $rules as array(*)*)
    as item()* {
    xf:extract-inner($rules)($nodes)
};

(:~
 : Returns an extractor function that returns selected nodes,
 : only outermost, in document order and duplicates eliminated.
 :)
declare function xf:extract-outer($rules as array(*)*)
    as function(item()*) as item()* {
    let $rules :=
        for $rule in $rules
            return xf:at($rule)
    return
        function($nodes as item()*) as item()* {
            outermost(
                for $rule in $rules
                    return $rule($nodes)
            )
        }
};

(:~
 : Apply extractor rules to `$nodes` and return the outermost nodes.
 :)
declare function xf:extract-outer($nodes as item()*, $rules as array(*)*)
    as item()* {
    xf:extract-outer($rules)($nodes)
};

(:~
 : Create a match function from a rule.
 :)
declare function xf:match($rule as array(*))
    as map(*)? {
    let $select := xf:selector([array:head($rule)], xf:select#1)
    let $body := xf:do(array:tail($rule))
    where array:size($rule) gt 0
    return
        map {
            'select': $select,
            'fn': $body
        }
};

(:~
 : Create a selector function from a rule.
 :)
declare function xf:at($rule as array(*))
    as function(item()*) as item()* {
    xf:selector($rule, xf:select-all#1)
};

(:~
 : Apply a transformation rule to input nodes.
 :)
declare function xf:at($nodes as item()*, $rule as array(*))
    as item()* {
    xf:at($rule)($nodes)
};

(:~
 : Create a node transformer that applies a node transformation rule to a
 : sequence of input nodes.
 :)
declare function xf:do($rule as array(*))
    as function(item()*) as item()* {
    function($nodes as item()*) as item()* {
        xf:do-nodes($nodes, $rule)
    }
};

(:~
 : Apply a node transformation rule to a sequence of nodes.
 :)
declare function xf:do($nodes as item()*, $rule as array(*))
    as item()* {
    xf:do-nodes($nodes, $rule)
};

(:~
 : Create a node transformer that applies a node transformation rule to each
 : individual input node.
 :)
declare function xf:each($rule as array(*))
    as function(item()*) as item()* {
    function($nodes as item()*) as item()* {
        for $node in $nodes
            return xf:do-nodes($node, $rule)
    }
};

(:~
 : Apply a node transformation rule to each individual input node.
 :)
declare function xf:each($nodes as item()*, $rule as array(*))
    as item()* {
    for $node in $nodes
        return xf:do-nodes($node, $rule)
};

declare %private function xf:do-nodes($nodes as item()*, $rule as array(*))
    as item()* {
    array:fold-left(
        $rule,
        $nodes,
        function($nodes, $step) {
            if ($step instance of function(*)) then
                $step($nodes)
            else
                $step
        }
    )
};

(:~
 : Only nodes for which the chain of expressions evaluates to `true()`
 : are passed through.
 :)
declare function xf:if($conditions as item()*)
    as function(item()*) as item()* {
    let $conditions := xf:comp-expression($conditions)
    return
        function($nodes as item()*) as item()* {
            fold-left(
                $conditions,
                $nodes,
                function($result, $step) {
                    if ($step($result)) then
                       $result
                    else
                        ()
                }
            )
        }
};

(:~
 : Filter nodes based on evaluating a chain of expressions, letting only
 : those nodes through for which it returns `true()`.
 :)
declare function xf:if($nodes as item()*, $conditions as item()*)
    as item()* {
    xf:if($conditions)($nodes)
};

(:~
 : Create a node transformer that replaces the child nodes of an
 : element with `$content`.
 :)
declare function xf:content($content as item()*)
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            element { node-name($node) } {
                $node/@*,
                $content
            }
        }
     (: HACK :)
    )(true())
};

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

(:~
 : Create a node transformer that replaces the nodes passed with
 : `$replacement`.
 :)
declare function xf:replace($replacement as item()*)
    as function(item()*) as item()* {
    function($nodes as item()*) as item()* {
        if (exists($nodes)) then
            $replacement
        else
            $nodes
    }
};

(:~
 : Replace `$nodes` with `$replacement`.
 :)
declare function xf:replace($nodes as item()*, $replacement as item()*)
    as item()* {
    xf:replace($replacement)($nodes)
};

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

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

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

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

(:~
 : Create a node transformer that appends `$append` nodes
 : to the child nodes of each element of `$nodes`.
 :)
declare function xf:append($append as item()*)
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            element { node-name($node) } {
                ($node/(@*,node()), $append)
            }
        }
     (: HACK :)
    )(true())
};

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

(:~
 : Create a node transformer that prepends `$prepend` nodes
 : to the child nodes of each element of `$nodes`.
 :)
declare function xf:prepend($prepend as item()*)
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            element { node-name($node) } {
                ($node/@*, $prepend, $node/node())
            }
        }
     (: HACK :)
    )(true())
};

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

(:~
 : Create a node transformer that returns a text node with
 : the space normalized string value of a node.
 :)
declare function xf:text()
    as function(item()*) as item()* {
    function($nodes as item()*) as item()* {
        if (exists($nodes)) then
            for $node in $nodes
                return
                    typeswitch ($node)
                    case map(*)
                    return
                        $node
                    case array(*)
                    return
                        $node
                    case function(*)
                    return
                        $node
                    default
                    return
                        text { string($node) }
        else
            ()
    }
};

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

(:~
 : Create a node transformer that sets attributes using a map
 : on each element in the nodes passed.
 :
 : Map keys must be valid as QNames or they will be ignored.
 :)
declare function xf:set-attr($attributes as item())
    as function(item()*) as item()* {
    let $attributes :=
        typeswitch ($attributes)
        case map(*)
            return
                map:for-each(
                    $attributes,
                    function($name, $value) {
                        if ($name castable as xs:QName) then
                            attribute { $name } { $value }
                        else
                            ()
                    }
                )
        case element()
            return $attributes/@*
        default
            return ()
    return
        xf:element-transformer(
            function($node as element()) as element() {
                element { node-name($node) } {
                    $attributes,
                    for $att in $node/@*
                        where node-name($att) != $attributes/node-name()
                        return $att,
                    $node/node()
                }
            }
        )($attributes)
};

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

(:~
 : Create a node transformer that adds one or more class names to
 : each element in the nodes passed.
 :)
declare function xf:add-class($names as xs:string*)
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            element { node-name($node) } {
                $node/@*[not(name(.) = 'class')],
                attribute class {
                    string-join(
                        distinct-values(
                            tokenize(
                                string-join(($node/@class,$names),' '),
                                '\s+')),
                        ' ')
                },
                $node/node()
            }
        }
    )($names)
};

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

(:~
 : Create a node transformer that removes one or more `$names` from the
 : class attribute. If the class attribute is empty after removing names it will
 : be removed from the element.
 :)
declare function xf:remove-class($names as xs:string*)
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            element { node-name($node) } {
                $node/@*[not(name(.) =  'class')],
                let $classes := distinct-values(
                    tokenize(($node/@class,'')[1],'\s+')[not(. = $names)])
                where exists($classes)
                return
                    attribute class { string-join($classes,' ') },
                $node/node()
            }
        }
    )($names)
};

(:~
 : Remove one or more `$names` from the class attribute of `$element`.
 : If the class attribute is empty after removing names it will be removed
 : from the element.
 :)
declare function xf:remove-class($nodes as item()*, $names as xs:string*)
    as item()* {
    xf:remove-class($names)($nodes)
};

(:~
 : Create a node transformer that remove attributes.
 :
 : If a name cannot be used as an attribute name (xs:QName) then
 : it will be silently ignored.
 :)
declare function xf:remove-attr($attributes as item()*)
    as function(item()*) as item()* {
    let $names :=
        typeswitch ($attributes)
        case xs:string*
            return
                for $name in $attributes
                return
                    if ($name eq '*') then
                        '*'
                    else if ($name castable as xs:QName) then
                        attribute { $name } { '' }
                    else
                        ()
        case element()
            return $attributes/@*
        case map(*)
            return
                map:for-each(
                    $attributes,
                    function($name,$value) {
                    if ($name castable as xs:QName) then
                        attribute { $name } { '' }
                    else
                        ()
                })
        default
            return ()
    return
        xf:element-transformer(
            function($node as element()) as element() {
                element { node-name($node) } {
                    for $att in $node/@*
                        where not($names = '*') and
                              not(node-name($att) = $names/node-name())
                        return $att
                }
            }
        )($attributes)
};

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

(:~
 : Create a node-transformer that renames element nodes, passing non-element
 : nodes and element child nodes through unmodified.
 :
 : Renaming can be done using a:
 :
 : - `xs:string`: renames all elements
 : - `map(*)`: looks up the element name in the map and uses the value as the
 :   new name
 : - `function($node as element()) as item()`: passes the element node to the
 :   function using the return value as the new element name
 :)
declare function xf:rename($map as item())
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            typeswitch ($map)
            case map(*)
                return
                    if ($map(node-name($node))) then
                        element { $map(node-name($node)) } {
                            $node/(@*,node())
                        }
                    else if ($map(name($node))) then
                        element { $map(name($node)) } {
                            $node/(@*,node())
                        }
                    else
                        $node
             case function(*)
                 return
                    element { $map($node) } {
                        $node/(@*,node())
                    }
             case xs:string
                 return
                    element { $map } {
                        $node/(@*,node())
                    }
             default
                 return $node
        }
    )(true())
};

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

(:~
 : Create a node transformer that wraps nodes in
 : an element `$element` and adding attributes from `$map` if present.
 : Attributes already on `$element` cannot be overwritten.
 : An empty sequence will not be wrapped.
 :)
declare function xf:wrap($element-spec as item())
    as function(item()*) as element()? {
    let $args :=
        if ($element-spec instance of element()) then
            $element-spec
        else
            array:flatten($element-spec)
    let $element as element() := $args[1]
    let $map as map(*)? := $args[2]
    where $element
    return
        function($nodes as item()*) as element()? {
            if (exists($nodes)) then
                element { node-name($element) } {
                    $element/@*,
                    if (exists($map)) then
                        map:for-each(
                            $map,
                            function($k,$v) {
                                if (not($element/@*[node-name(.) eq xs:QName($k)])) then
                                    attribute { $k } { $v }
                                else
                                    ()
                            }
                        )
                    else
                        (),
                    $nodes
                }
            else
                ()
        }
};

(:~
 : Wraps `$nodes` in element `$node`. An empty sequence will
 : not be wrapped.
 :)
declare function xf:wrap($nodes as item()*, $element-spec as item())
    as element()? {
    xf:wrap($element-spec)($nodes)
};

(:~
 : Create a node transformer that removes (unwraps) the
 : outer element of all nodes that are elements. Other nodes
 : are passed through unmodified.
 :
 : This function is safe for use as a node selector.
 :)
declare function xf:unwrap()
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as node()* {
            $node/node()
          (: FIXME: passing true() is a bit of a hack, because
             element-transformers check for empty arg even if they
             don't need one :)
        }
    )(true())
};

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

(:~
 : Returns a node transformer that transforms nodes using
 : an XSLT stylesheet.
 :)
declare function xf:xslt($stylesheet as item())
    as function(node()*) as node()* {
    xf:xslt($stylesheet, map {})
};

(:~
 : Create a node transformer that transforms nodes using
 : an XSLT stylesheet with parameters.
 :)
declare function xf:xslt($stylesheet as item(), $params as item())
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            xslt:transform($node, $stylesheet, $params)/*
        }
    )($params)
};

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

(:
 : Creates a generic element node transformer function. It applies
 : `$transform` to each element passed.
 :)
declare function xf:element-transformer($transform as function(element()) as item()*)
    as function(*) {
    function($args as item()*) as function(*) {
        function($nodes as item()*) as item()* {
            if (exists($args)) then
                for $node in $nodes
                    return
                        if ($node instance of element()) then
                            $transform($node)
                        else
                            $node
            else
                $nodes
        }
    }
};

(:~
 : Sets up a default environment which can be customized.
 : Represents the default bindings for selecting nodes.
 : The context is set to $nodes and all it's descendant elements.
 : It also sets up a helper function $in to enable proper checks on tokenized
 : (space-delimited) attribute values such as @class.
 :)
declare function xf:match-environment() {
    map {
        'bindings': function($nodes as node()*) as map(*) {
            map {
                '': $nodes/descendant-or-self::node(),
                xs:QName('in'): function($att, $token) as xs:boolean {
                    $token = tokenize(string($att),'\s+')
                }
            }
        },
        'query': function($selector as xs:string) {
            'declare variable $in external; ' || $selector
        }
    }
};

declare function xf:expr-environment() {
    map {
        'bindings': function($nodes as node()*) as map(*) {
            map {
                '': $nodes,
                xs:QName('in'): function($att, $token) as xs:boolean {
                    $token = tokenize(string($att),'\s+')
                }
            }
        },
        'query': function($selector as xs:string) {
            'declare variable $in external; ' || $selector
        }
    }
};

(:~
 : Find matches for XPath expression string applied to passed in nodes
 : including all descendents.
 :)
declare function xf:select-all($selector as xs:string)
    as function(item()*) as item()* {
    xf:select-with-env($selector, xf:match-environment())
};

(:~
 : Find matches for XPath expression string applied to passed in nodes
 : including all descendents.
 :)
declare function xf:select-all($nodes as node()*, $selector as xs:string)
    as function(item()*) as item()* {
    xf:select-all($selector)($nodes)
};

(:~
 : Find matches for XPath expression string applied to passed in nodes.
 :)
declare function xf:select($selector as xs:string)
    as function(item()*) as item()* {
    xf:select-with-env($selector, xf:expr-environment())
};

(:~
 : Find matches for XPath expression string applied to passed in nodes.
 :)
declare function xf:select($nodes as item()*, $selector as xs:string)
    as function(item()*) as item()* {
    xf:select($selector)($nodes)
};

declare %private function xf:select-with-env($selector as xs:string, $env as map(*))
    as function(item()*) as item()* {
    let $query := $env('query')($selector)
    let $bindings := $env('bindings')
    return
        function($nodes as item()*) as item()* {
            xquery:eval($query, $bindings($nodes))
        }
};

(:~
 : Copies nodes to output, and calls apply for
 : nodes that are wrapped inside <xf:apply>.
 :)
declare %private function xf:copy-nodes($nodes as item()*, $xform as map(*)*)
    as item()* {
    for $node in $nodes
        return
            if ($node/self::xf:apply) then
                xf:apply-nodes($node, (), $xform)
            else if ($node instance of element()) then
                element { node-name($node) } {
                    $node/@*,
                    xf:copy-nodes($node/node(), $xform)
                }
            else if ($node instance of document-node()) then
                document {
                    xf:copy-nodes($node/node(), $xform)
                }
            else $node
};

(:~
 : Applies nodes to output, but runs the template node transformer when it
 : encounters a node that was matched.
 :)
declare %private function xf:apply-nodes($nodes as item()*, $context as map(*)*, $xform as map(*)*)
    as item()* {
    for $node in $nodes
        let $context := (xf:match-templates($node, $xform), $context)
        let $match := xf:matched-template($node, $context)
        return
            if ($node/self::xf:apply) then
                xf:apply-nodes($node/node(), $context, $xform)
            else if ($match instance of map(*)) then
                xf:copy-nodes($match('fn')($node), $xform)
            else if ($node instance of element()) then
                element { node-name($node) } {
                    xf:apply-nodes($node/(@*, node()), $context, $xform)
                }
            else if ($node instance of document-node()) then
                document {
                    xf:apply-nodes($node/node(), $context, $xform)
                }
            else
                $node
};

(:~
 : Apply to be used from within templates.
 :)
declare function xf:apply($nodes as item()*)
    as element() {
    xf:apply()($nodes)
};

(:~
 : Returns an apply node transfomrer. When used in `xf:transform` it will
 : pass the nodes through all tansformation rules similar to
 : `<xsl:apply-templates/>` in XSLT.
 :)
declare function xf:apply()
    as function(item()*) as element() {
    function ($nodes as item()*) as element() {
        typeswitch ($nodes)
        case element()
            return
                element { node-name($nodes) } {
                    $nodes/@*,
                    <xf:apply>{ $nodes/node() }</xf:apply>
                }
        default
            return
                <xf:apply>{ $nodes }</xf:apply>
    }
};

(:~
 : Find all templates matched by this node and adds the matched nodes
 : to the templates.
 :)
declare %private function xf:match-templates($node as item(), $xform as map(*)*)
    as map(*)* {
    fold-left(
        $xform,
        (),
        function($matched-templates as map(*)*, $template as map(*)) {
            let $matched-nodes := $template('select')($node)
            return
                if (exists($matched-nodes)) then
                    ($matched-templates, map:merge(($template, map { 'nodes': $matched-nodes })))
                else
                    $matched-templates
        }
    )
};

(:~
 : Looks in the $context to find a template that was matched by this
 : node. First one found (most-specific) wins.
 :)
declare %private function xf:matched-template($node as item(), $context as map(*)*)
    as map(*)? {
    if (count($context) gt 0) then
        hof:until(
            function($context as map(*)*) {
                empty($context) or
                xf:is-node-in-sequence($node, head($context)('nodes')) },
            function($context as map(*)*) {
                tail($context) },
            $context
        )[1]
    else
        ()
};

(:~
 : Define a transformation that starts with selecting nodes with an
 : XPath expression.
 :)
declare %private function xf:selector($steps as array(*), $selector-fn as function(*))
    as function(item()*) as item()* {
    (: compile the steps :)
    let $steps :=
        array:fold-left(
            $steps,
            (),
            function($result, $step) {
                if ($step instance of xs:string) then
                    ($result, $selector-fn($step))
                else if ($step instance of function(*)) then
                    ($result, $step)
                else if ($step instance of node()+) then
                    ($result,
                        function($node as node()+) as node()* {
                            for $node in $step return xf:copy($node)
                        })
                else if ($step instance of empty-sequence()) then
                    ($result,
                        function($node as item()*) as item()* {
                            ()
                        })
                else
                    ($result, text { $step })
            }
        )
    return
        function($nodes as item()*) as item()* {
            for $selected in head($steps)($nodes)
            return
                fold-left(
                    tail($steps),
                    $selected,
                    function($result, $step) {
                        $step($result)
                    }
                )
        }
};

declare %private function xf:comp-expression($expressions as item()*)
    as (function(item()*) as item()*)* {
    for $expression in $expressions
        return
            if ($expression instance of xs:string) then
                xf:select($expression)
            else $expression
};

(:~
 : Returns `true()` if the node `$node` is also in sequence `$seq`.
 :
 : @see http://www.xqueryfunctions.com/xq/functx_is-node-in-sequence.html
 :)
declare %private function xf:is-node-in-sequence($node as node()?, $seq as node()*)
    as xs:boolean {
    some $nodeInSeq in $seq satisfies $nodeInSeq is $node
};

declare %private function xf:copy($node as node())
    as node() {
    typeswitch($node)
    case element()
        return
            element { node-name($node) } {
                $node/@*,
                for $child in $node/node()
                     return xf:copy($child) }
    default return $node
};

xquery version "3.0";

(:~
 : Origami templating.
 :
 : Requires Basex 8.0 20141221 or later.
 :
 : @version 0.4
 : @author Marc van Grootel
 : @see https://github.com/xokomola/origami
 :)

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

(:~
 : Load an HTML resource.
 :)
declare function xf:html-resource($url-or-path) {
    if (starts-with($url-or-path,'http:/')) then
        xf:fetch-html($url-or-path)
    else
        xf:parse-html($url-or-path)
};

(:~
 : Load an XML resource.
 :)
declare function xf:xml-resource($url-or-path) {
    doc($url-or-path)
};

(:~
 : Load a plain text resource.
 :)
declare function xf:text-resource($url-or-path) {
    unparsed-text($url-or-path)
};

(:~
 : Fetch and parse HTML given a URL.
 :)
declare function xf:fetch-html($url) {
    html:parse(fetch:binary($url))
};

(:~
 : Parse HTML from a filesystem path.
 :)
declare function xf:parse-html($path) {
    html:parse(file:read-binary($path))
};

(:~
 : Returns a template function.
 :)
declare function xf:template($template as item()*, $selector as array(*)?, $model as item()*)
    as function(*) {
    let $at := if ($selector instance of array(*)) then xf:at($selector) else function($nodes) { $nodes }
    return
        typeswitch ($model)
        (: test array first because it is also a function :)
        case array(*)*
        return
            function() as item()* {
                $template => $at() => xf:transform($model)
            }
        case function(*)
        return
            switch (function-arity($model))
            case 0
            return
                function() as item()* {
                    $template => $at() => xf:transform($model)
                }
            case 1
            return
                function($arg1 as item()?) as item()* {
                    $template => $at() => xf:transform(apply($model, [$arg1]))
                }
            case 2
            return
                function($arg1 as item()?, $arg2 as item()?) as item()* {
                    $template => $at() => xf:transform(apply($model, [$arg1, $arg2]))
                }
            case 3
            return
                function($arg1 as item()?, $arg2 as item()?, $arg3 as item()?) as item()* {
                    $template => $at() => xf:transform(apply($model, [$arg1, $arg2, $arg3]))
                }
            (: max arity-4 supported :)
            case 4
            return
                function($arg1 as item()?, $arg2 as item()?, $arg3 as item()?, $arg4 as item()?) as item()* {
                    $template => $at() => xf:transform(apply($model, [$arg1, $arg2, $arg3, $arg4]))
                }
            default
            return
                error(xf:ArityNotSupportedError, 'A model function cannot have more than 4 arguments')

        case empty-sequence()
        return
            function() as item()* {
                $template => $at()
            }
        default
        return
            error(xf:InvalidModelError, 'This model cannot be used')
};

(:~
 : Apply `$template` to template function.
 :)
declare function xf:template($template as item(), $model as item()*)
    as function(*) {
    xf:template($template, (), $model)
};

(:~
 : Template identity transform.
 :)
declare function xf:template($template as item())
    as function(*) {
    xf:template($template, (), ())
};

(:~
 : Returns a Transformer function.
 :)
declare function xf:transform($rules as array(*)*)
    as function(item()*) as item()* {
    let $rules :=
        for $rule in $rules
            return xf:match($rule)
    return
        function($nodes as item()*) as item()* {
            xf:apply-nodes(
                $nodes,
                (),
                $rules)
        }
};

(:~
 : Transform input, using the specified rules.
 :)
declare function xf:transform($nodes as item()*, $rules as array(*)*)
    as item()* {
    xf:transform($rules)($nodes)
};

(:~
 : Identity transformer.
 :)
declare function xf:transform() { xf:transform(()) };

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

(:~
 : Extracts nodes from input, using the specified rules.
 :)
declare function xf:extract($nodes as item()*, $rules as array(*)*)
    as item()* {
    xf:extract($rules)($nodes)
};

(:~
 : Returns an extractor function that returns selected nodes,
 : only innermost, in document order and duplicates eliminitated.
 :)
declare function xf:extract-inner($rules as array(*)*)
    as function(item()*) as item()* {
    let $rules :=
        for $rule in $rules
            return
                xf:at($rule)
    return
        function($nodes as item()*) as item()* {
            innermost(
                for $rule in $rules
                    return $rule($nodes)
            )
        }
};

(:~
 : Apply extractor rules to `$nodes` and return the innermost nodes.
 :)
declare function xf:extract-inner($nodes as item()*, $rules as array(*)*)
    as item()* {
    xf:extract-inner($rules)($nodes)
};

(:~
 : Returns an extractor function that returns selected nodes,
 : only outermost, in document order and duplicates eliminated.
 :)
declare function xf:extract-outer($rules as array(*)*)
    as function(item()*) as item()* {
    let $rules :=
        for $rule in $rules
            return xf:at($rule)
    return
        function($nodes as item()*) as item()* {
            outermost(
                for $rule in $rules
                    return $rule($nodes)
            )
        }
};

(:~
 : Apply extractor rules to `$nodes` and return the outermost nodes.
 :)
declare function xf:extract-outer($nodes as item()*, $rules as array(*)*)
    as item()* {
    xf:extract-outer($rules)($nodes)
};

(:~
 : Create a match function from a rule.
 :)
declare function xf:match($rule as array(*))
    as map(*)? {
    let $select := xf:selector([array:head($rule)], xf:select#1)
    let $body := xf:do(array:tail($rule))
    where array:size($rule) gt 0
    return
        map {
            'select': $select,
            'fn': $body
        }
};

(:~
 : Create a selector function from a rule.
 :)
declare function xf:at($rule as array(*))
    as function(item()*) as item()* {
    xf:selector($rule, xf:select-all#1)
};

(:~
 : Apply a transformation rule to input nodes.
 :)
declare function xf:at($nodes as item()*, $rule as array(*))
    as item()* {
    xf:at($rule)($nodes)
};

(:~
 : Create a node transformer that applies a node transformation rule to a
 : sequence of input nodes.
 :)
declare function xf:do($rule as array(*))
    as function(item()*) as item()* {
    function($nodes as item()*) as item()* {
        xf:do-nodes($nodes, $rule)
    }
};

(:~
 : Apply a node transformation rule to a sequence of nodes.
 :)
declare function xf:do($nodes as item()*, $rule as array(*))
    as item()* {
    xf:do-nodes($nodes, $rule)
};

(:~
 : Create a node transformer that applies a node transformation rule to each
 : individual input node.
 :)
declare function xf:each($rule as array(*))
    as function(item()*) as item()* {
    function($nodes as item()*) as item()* {
        for $node in $nodes
            return xf:do-nodes($node, $rule)
    }
};

(:~
 : Apply a node transformation rule to each individual input node.
 :)
declare function xf:each($nodes as item()*, $rule as array(*))
    as item()* {
    for $node in $nodes
        return xf:do-nodes($node, $rule)
};

declare %private function xf:do-nodes($nodes as item()*, $rule as array(*))
    as item()* {
    array:fold-left(
        $rule,
        $nodes,
        function($nodes, $step) {
            if ($step instance of function(*)) then
                $step($nodes)
            else
                $step
        }
    )
};

(:~
 : Only nodes for which the chain of expressions evaluates to `true()`
 : are passed through.
 :)
declare function xf:if($conditions as item()*)
    as function(item()*) as item()* {
    let $conditions := xf:comp-expression($conditions)
    return
        function($nodes as item()*) as item()* {
            fold-left(
                $conditions,
                $nodes,
                function($result, $step) {
                    if ($step($result)) then
                       $result
                    else
                        ()
                }
            )
        }
};

(:~
 : Filter nodes based on evaluating a chain of expressions, letting only
 : those nodes through for which it returns `true()`.
 :)
declare function xf:if($nodes as item()*, $conditions as item()*)
    as item()* {
    xf:if($conditions)($nodes)
};

(:~
 : Create a node transformer that replaces the child nodes of an
 : element with `$content`.
 :)
declare function xf:content($content as item()*)
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            element { node-name($node) } {
                $node/@*,
                $content
            }
        }
     (: HACK :)
    )(true())
};

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

(:~
 : Create a node transformer that replaces the nodes passed with
 : `$replacement`.
 :)
declare function xf:replace($replacement as item()*)
    as function(item()*) as item()* {
    function($nodes as item()*) as item()* {
        if (exists($nodes)) then
            $replacement
        else
            $nodes
    }
};

(:~
 : Replace `$nodes` with `$replacement`.
 :)
declare function xf:replace($nodes as item()*, $replacement as item()*)
    as item()* {
    xf:replace($replacement)($nodes)
};

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

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

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

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

(:~
 : Create a node transformer that appends `$append` nodes
 : to the child nodes of each element of `$nodes`.
 :)
declare function xf:append($append as item()*)
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            element { node-name($node) } {
                ($node/(@*,node()), $append)
            }
        }
     (: HACK :)
    )(true())
};

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

(:~
 : Create a node transformer that prepends `$prepend` nodes
 : to the child nodes of each element of `$nodes`.
 :)
declare function xf:prepend($prepend as item()*)
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            element { node-name($node) } {
                ($node/@*, $prepend, $node/node())
            }
        }
     (: HACK :)
    )(true())
};

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

(:~
 : Create a node transformer that returns a text node with
 : the space normalized string value of a node.
 :)
declare function xf:text()
    as function(item()*) as item()* {
    function($nodes as item()*) as item()* {
        if (exists($nodes)) then
            for $node in $nodes
                return
                    typeswitch ($node)
                    case map(*)
                    return
                        $node
                    case array(*)
                    return
                        $node
                    case function(*)
                    return
                        $node
                    default
                    return
                        text { string($node) }
        else
            ()
    }
};

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

(:~
 : Create a node transformer that sets attributes using a map
 : on each element in the nodes passed.
 :
 : Map keys must be valid as QNames or they will be ignored.
 :)
declare function xf:set-attr($attributes as item())
    as function(item()*) as item()* {
    let $attributes :=
        typeswitch ($attributes)
        case map(*)
            return
                map:for-each(
                    $attributes,
                    function($name, $value) {
                        if ($name castable as xs:QName) then
                            attribute { $name } { $value }
                        else
                            ()
                    }
                )
        case element()
            return $attributes/@*
        default
            return ()
    return
        xf:element-transformer(
            function($node as element()) as element() {
                element { node-name($node) } {
                    $attributes,
                    for $att in $node/@*
                        where node-name($att) != $attributes/node-name()
                        return $att,
                    $node/node()
                }
            }
        )($attributes)
};

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

(:~
 : Create a node transformer that adds one or more class names to
 : each element in the nodes passed.
 :)
declare function xf:add-class($names as xs:string*)
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            element { node-name($node) } {
                $node/@*[not(name(.) = 'class')],
                attribute class {
                    string-join(
                        distinct-values(
                            tokenize(
                                string-join(($node/@class,$names),' '),
                                '\s+')),
                        ' ')
                },
                $node/node()
            }
        }
    )($names)
};

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

(:~
 : Create a node transformer that removes one or more `$names` from the
 : class attribute. If the class attribute is empty after removing names it will
 : be removed from the element.
 :)
declare function xf:remove-class($names as xs:string*)
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            element { node-name($node) } {
                $node/@*[not(name(.) =  'class')],
                let $classes := distinct-values(
                    tokenize(($node/@class,'')[1],'\s+')[not(. = $names)])
                where exists($classes)
                return
                    attribute class { string-join($classes,' ') },
                $node/node()
            }
        }
    )($names)
};

(:~
 : Remove one or more `$names` from the class attribute of `$element`.
 : If the class attribute is empty after removing names it will be removed
 : from the element.
 :)
declare function xf:remove-class($nodes as item()*, $names as xs:string*)
    as item()* {
    xf:remove-class($names)($nodes)
};

(:~
 : Create a node transformer that remove attributes.
 :
 : If a name cannot be used as an attribute name (xs:QName) then
 : it will be silently ignored.
 :)
declare function xf:remove-attr($attributes as item()*)
    as function(item()*) as item()* {
    let $names :=
        typeswitch ($attributes)
        case xs:string*
            return
                for $name in $attributes
                return
                    if ($name eq '*') then
                        '*'
                    else if ($name castable as xs:QName) then
                        attribute { $name } { '' }
                    else
                        ()
        case element()
            return $attributes/@*
        case map(*)
            return
                map:for-each(
                    $attributes,
                    function($name,$value) {
                    if ($name castable as xs:QName) then
                        attribute { $name } { '' }
                    else
                        ()
                })
        default
            return ()
    return
        xf:element-transformer(
            function($node as element()) as element() {
                element { node-name($node) } {
                    for $att in $node/@*
                        where not($names = '*') and
                              not(node-name($att) = $names/node-name())
                        return $att
                }
            }
        )($attributes)
};

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

(:~
 : Create a node-transformer that renames element nodes, passing non-element
 : nodes and element child nodes through unmodified.
 :
 : Renaming can be done using a:
 :
 : - `xs:string`: renames all elements
 : - `map(*)`: looks up the element name in the map and uses the value as the
 :   new name
 : - `function($node as element()) as item()`: passes the element node to the
 :   function using the return value as the new element name
 :)
declare function xf:rename($map as item())
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            typeswitch ($map)
            case map(*)
                return
                    if ($map(node-name($node))) then
                        element { $map(node-name($node)) } {
                            $node/(@*,node())
                        }
                    else if ($map(name($node))) then
                        element { $map(name($node)) } {
                            $node/(@*,node())
                        }
                    else
                        $node
             case function(*)
                 return
                    element { $map($node) } {
                        $node/(@*,node())
                    }
             case xs:string
                 return
                    element { $map } {
                        $node/(@*,node())
                    }
             default
                 return $node
        }
    )(true())
};

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

(:~
 : Create a node transformer that wraps nodes in
 : an element `$element` and adding attributes from `$map` if present.
 : Attributes already on `$element` cannot be overwritten.
 : An empty sequence will not be wrapped.
 :)
declare function xf:wrap($element-spec as item())
    as function(item()*) as element()? {
    let $args :=
        if ($element-spec instance of element()) then
            $element-spec
        else
            array:flatten($element-spec)
    let $element as element() := $args[1]
    let $map as map(*)? := $args[2]
    where $element
    return
        function($nodes as item()*) as element()? {
            if (exists($nodes)) then
                element { node-name($element) } {
                    $element/@*,
                    if (exists($map)) then
                        map:for-each(
                            $map,
                            function($k,$v) {
                                if (not($element/@*[node-name(.) eq xs:QName($k)])) then
                                    attribute { $k } { $v }
                                else
                                    ()
                            }
                        )
                    else
                        (),
                    $nodes
                }
            else
                ()
        }
};

(:~
 : Wraps `$nodes` in element `$node`. An empty sequence will
 : not be wrapped.
 :)
declare function xf:wrap($nodes as item()*, $element-spec as item())
    as element()? {
    xf:wrap($element-spec)($nodes)
};

(:~
 : Create a node transformer that removes (unwraps) the
 : outer element of all nodes that are elements. Other nodes
 : are passed through unmodified.
 :
 : This function is safe for use as a node selector.
 :)
declare function xf:unwrap()
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as node()* {
            $node/node()
          (: FIXME: passing true() is a bit of a hack, because
             element-transformers check for empty arg even if they
             don't need one :)
        }
    )(true())
};

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

(:~
 : Returns a node transformer that transforms nodes using
 : an XSLT stylesheet.
 :)
declare function xf:xslt($stylesheet as item())
    as function(node()*) as node()* {
    xf:xslt($stylesheet, map {})
};

(:~
 : Create a node transformer that transforms nodes using
 : an XSLT stylesheet with parameters.
 :)
declare function xf:xslt($stylesheet as item(), $params as item())
    as function(item()*) as item()* {
    xf:element-transformer(
        function($node as element()) as element() {
            xslt:transform($node, $stylesheet, $params)/*
        }
    )($params)
};

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

(:
 : Creates a generic element node transformer function. It applies
 : `$transform` to each element passed.
 :)
declare function xf:element-transformer($transform as function(element()) as item()*)
    as function(*) {
    function($args as item()*) as function(*) {
        function($nodes as item()*) as item()* {
            if (exists($args)) then
                for $node in $nodes
                    return
                        if ($node instance of element()) then
                            $transform($node)
                        else
                            $node
            else
                $nodes
        }
    }
};

(:~
 : Sets up a default environment which can be customized.
 : Represents the default bindings for selecting nodes.
 : The context is set to $nodes and all it's descendant elements.
 : It also sets up a helper function $in to enable proper checks on tokenized
 : (space-delimited) attribute values such as @class.
 :)
declare function xf:environment() {
    map {
        'bindings': function($nodes as node()*) as map(*) {
            map {
                '': $nodes/descendant-or-self::node(),
                xs:QName('in'): function($att, $token) as xs:boolean {
                    $token = tokenize(string($att),'\s+')
                }
            }
        },
        'query': function($selector as xs:string) {
            'declare variable $in external; ' || $selector
        }
    }
};

declare function xf:expr-environment() {
    map {
        'bindings': function($nodes as node()*) as map(*) {
            map {
                '': $nodes,
                xs:QName('in'): function($att, $token) as xs:boolean {
                    $token = tokenize(string($att),'\s+')
                }
            }
        },
        'query': function($selector as xs:string) {
            'declare variable $in external; ' || $selector
        }
    }
};

(:~
 : Find matches for XPath expression string applied to passed in nodes
 : including all descendents.
 :)
declare function xf:select-all($selector as xs:string)
    as function(item()*) as item()* {
    xf:select-with-env($selector, xf:environment())
};

(:~
 : Find matches for XPath expression string applied to passed in nodes
 : including all descendents.
 :)
declare function xf:select-all($nodes as node()*, $selector as xs:string)
    as function(item()*) as item()* {
    xf:select-all($selector)($nodes)
};

(:~
 : Find matches for XPath expression string applied to passed in nodes.
 :)
declare function xf:select($selector as xs:string)
    as function(item()*) as item()* {
    xf:select-with-env($selector, xf:expr-environment())
};

(:~
 : Find matches for XPath expression string applied to passed in nodes.
 :)
declare function xf:select($nodes as item()*, $selector as xs:string)
    as function(item()*) as item()* {
    xf:select($selector)($nodes)
};

declare %private function xf:select-with-env($selector as xs:string, $env as map(*))
    as function(item()*) as item()* {
    let $query := $env('query')($selector)
    let $bindings := $env('bindings')
    return
        function($nodes as item()*) as item()* {
            xquery:eval($query, $bindings($nodes))
        }
};

(:~
 : Copies nodes to output, and calls apply for
 : nodes that are wrapped inside <xf:apply>.
 :)
declare %private function xf:copy-nodes($nodes as item()*, $xform as map(*)*)
    as item()* {
    for $node in $nodes
        return
            if ($node/self::xf:apply) then
                xf:apply-nodes($node, (), $xform)
            else if ($node instance of element()) then
                element { node-name($node) } {
                    $node/@*,
                    xf:copy-nodes($node/node(), $xform)
                }
            else if ($node instance of document-node()) then
                document {
                    xf:copy-nodes($node/node(), $xform)
                }
            else $node
};

(:~
 : Applies nodes to output, but runs the template node transformer when it
 : encounters a node that was matched.
 :)
declare %private function xf:apply-nodes($nodes as item()*, $context as map(*)*, $xform as map(*)*)
    as item()* {
    for $node in $nodes
        let $context := (xf:match-templates($node, $xform), $context)
        let $match := xf:matched-template($node, $context)
        return
            if ($node/self::xf:apply) then
                xf:apply-nodes($node/node(), $context, $xform)
            else if ($match instance of map(*)) then
                xf:copy-nodes($match('fn')($node), $xform)
            else if ($node instance of element()) then
                element { node-name($node) } {
                    xf:apply-nodes($node/(@*, node()), $context, $xform)
                }
            else if ($node instance of document-node()) then
                document {
                    xf:apply-nodes($node/node(), $context, $xform)
                }
            else
                $node
};

(:~
 : Apply to be used from within templates.
 :)
declare function xf:apply($nodes as item()*)
    as element() {
    xf:apply()($nodes)
};

(:~
 : Returns an apply node transfomrer. When used in `xf:transform` it will
 : pass the nodes through all tansformation rules similar to
 : `<xsl:apply-templates/>` in XSLT.
 :)
declare function xf:apply()
    as function(item()*) as element() {
    function ($nodes as item()*) as element() {
        typeswitch ($nodes)
        case element()
            return
                element { node-name($nodes) } {
                    $nodes/@*,
                    <xf:apply>{ $nodes/node() }</xf:apply>
                }
        default
            return
                <xf:apply>{ $nodes }</xf:apply>
    }
};

(:~
 : Find all templates matched by this node and adds the matched nodes
 : to the templates.
 :)
declare %private function xf:match-templates($node as item(), $xform as map(*)*)
    as map(*)* {
    fold-left(
        $xform,
        (),
        function($matched-templates as map(*)*, $template as map(*)) {
            let $matched-nodes := $template('select')($node)
            return
                if (exists($matched-nodes)) then
                    ($matched-templates, map:merge(($template, map { 'nodes': $matched-nodes })))
                else
                    $matched-templates
        }
    )
};

(:~
 : Looks in the $context to find a template that was matched by this
 : node. First one found (most-specific) wins.
 :)
declare %private function xf:matched-template($node as item(), $context as map(*)*)
    as map(*)? {
    if (count($context) gt 0) then
        hof:until(
            function($context as map(*)*) {
                empty($context) or
                xf:is-node-in-sequence($node, head($context)('nodes')) },
            function($context as map(*)*) {
                tail($context) },
            $context
        )[1]
    else
        ()
};

(:~
 : Define a transformation that starts with selecting nodes with an
 : XPath expression.
 :)
declare %private function xf:selector($steps as array(*), $selector-fn as function(*))
    as function(item()*) as item()* {
    (: compile the steps :)
    let $steps :=
        array:fold-left(
            $steps,
            (),
            function($result, $step) {
                if ($step instance of xs:string) then
                    ($result, $selector-fn($step))
                else if ($step instance of function(*)) then
                    ($result, $step)
                else if ($step instance of node()+) then
                    ($result,
                        function($node as node()+) as node()* {
                            for $node in $step return xf:copy($node)
                        })
                else if ($step instance of empty-sequence()) then
                    ($result,
                        function($node as item()*) as item()* {
                            ()
                        })
                else
                    ($result, text { $step })
            }
        )
    return
        function($nodes as item()*) as item()* {
            for $selected in head($steps)($nodes)
            return
                fold-left(
                    tail($steps),
                    $selected,
                    function($result, $step) {
                        $step($result)
                    }
                )
        }
};

declare %private function xf:comp-expression($expressions as item()*)
    as (function(item()*) as item()*)* {
    for $expression in $expressions
        return
            if ($expression instance of xs:string) then
                xf:select($expression)
            else $expression
};

(:~
 : Returns `true()` if the node `$node` is also in sequence `$seq`.
 :
 : @see http://www.xqueryfunctions.com/xq/functx_is-node-in-sequence.html
 :)
declare %private function xf:is-node-in-sequence($node as node()?, $seq as node()*)
    as xs:boolean {
    some $nodeInSeq in $seq satisfies $nodeInSeq is $node
};

declare %private function xf:copy($node as node())
    as node() {
    typeswitch($node)
    case element()
        return
            element { node-name($node) } {
                $node/@*,
                for $child in $node/node()
                     return xf:copy($child) }
    default return $node
};