(:~
 :
 : Copyright 2007 Ryan Grimm
 :
 : A module to update in memory nodes.  These function are intended to
 : mirror the built in update function (eg: xdmp:node-insert-child).
 : One difference between these functions and the built in update functions
 : is that the new node can actually be a sequence of nodes.  It is
 : recommended to use this feature as much as possible for performance
 : reasons.  Another difference is that these functions return the
 : modified XML back to you.
 :
 : Note: Functions that start with an underscore are private functions.
 :
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at
 :
 :     http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, software
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
 :
 : @author Ryan Grimm (grimm@xqdev.com)
 : @version 0.1
 :
 :)

(:
 : updated by Marc Van Cappellen (marc.van.cappellen@datadirect.com)
 : - implementation is compliant with XQuery 1.0 (http://www.w3.org/TR/2007/REC-xquery-20070123/)
 : - document-nodes are now also supported
 :)

module namespace mem = "http://xqdev.com/in-mem-update";

(:
	Inserts the given nodes as children of the given node
:)
declare function mem:node-insert-child(
	$parentNode as element(),
	$newNode as node()*
) as node()*
{
	mem:_process(root($parentNode), $parentNode, $newNode, "insert-child")
};

(:
	Inserts the new nodes before the given node
:)
declare function mem:node-insert-before(
	$sibling as node(),
	$newNode as node()*
) as node()*
{
	mem:_process(root($sibling), $sibling, $newNode, "insert-before")
};

(:
	Inserts the new nodes after the given node
:)
declare function mem:node-insert-after(
	$sibling as node(),
	$newNode as node()*
) as node()*
{
	mem:_process(root($sibling), $sibling, $newNode, "insert-after")
};

(:
	Replaces the given nodes with the new node
:)
declare function mem:node-replace(
	$goneNodes as node()*,
	$newNode as node()
) as node()*
{
	mem:_process(root($goneNodes[1]), $goneNodes, $newNode, "delete")
};

(:
	Deletes the given nodes
:)
declare function mem:node-delete(
	$goneNodes as node()*
) as node()*
{
	mem:_process(root($goneNodes[1]), $goneNodes, (), "delete")
};

(: Private functions :)

(:
	Recursive descent
:)
declare function mem:_descend(
	$node as node(),
	$goneNodes as node()*,
	$newNode as node()*,
	$mode as xs:string
) as node()*
{
	for $child in ($node/@*, $node/node())
	return mem:_process($child, $goneNodes, $newNode, $mode)
};

(:
	Processes an element.  Elements that match one of the modifier nodes are
	handeled depending on the mode.  Don't feel bad if you don't quite
	understand this code.
:)
declare function mem:_process(
	$node as node(),
	$modifierNodes as node()*,
	$newNode as node()*,
	$mode as xs:string
) as node()*
{
  if($node instance of document-node(element(*)))
  then document {mem:_process($node/element(), $modifierNodes, $newNode, $mode) treat as element()}
  else
  	let $matches := sum(
  		for $gone in $modifierNodes
  		return if($node is $gone) then 1 else 0
  	)
  	return
  		if($mode = "delete")
  		then
  			if($matches > 0)
  			then $newNode
  			else mem:_processNode($node, $modifierNodes, $newNode, $mode)
  		else if($mode = "insert-child")
  		then
  			if($matches > 0)
  			then element { QName(namespace-uri($node), local-name($node)) } { (
  					$node/@*, $node/node(), $newNode
  				) }
  			else mem:_processNode($node, $modifierNodes, $newNode, $mode)
  		else if($mode = "insert-after")
  		then
  			if($matches > 0)
  			then ($node, $newNode)
  			else mem:_processNode($node, $modifierNodes, $newNode, $mode)
  		else if($mode = "insert-before")
  		then
  			if($matches > 0)
  			then ($newNode, $node)
  			else mem:_processNode($node, $modifierNodes, $newNode, $mode)
  		else ()
};

(:
	Constructs a node if need be and processes all of its children
:)
declare function mem:_processNode(
	$node as node(),
	$modifierNodes as node()*,
	$newNode as node()*,
	$mode as xs:string
) as node()
{
	if($node instance of element(*))
	then element { QName(namespace-uri($node), local-name($node)) } {
		mem:_descend($node, $modifierNodes, $newNode, $mode)
	}
  else $node
};
(: Stylus Studio meta-information - (c) 2004-2007. Progress Software Corporation. All rights reserved.
<metaInformation>
<scenarios ><scenario default="yes" name="Scenario1" userelativepaths="yes" externalpreview="no" useresolver="yes" url="" outputurl="" processortype="datadirect" tcpport="0" profilemode="0" profiledepth="" profilelength="" urlprofilexml="" commandline="" additionalpath="" additionalclasspath="" postprocessortype="none" postprocesscommandline="" postprocessadditionalpath="" postprocessgeneratedext="" host="" port="0" user="" password="" validateoutput="no" validator="internal" customvalidator="" ><advancedProperties name="bSchemaAware" value="true"/><advancedProperties name="bXml11" value="false"/><advancedProperties name="iValidation" value="0"/><advancedProperties name="bExtensions" value="true"/><advancedProperties name="iWhitespace" value="0"/><advancedProperties name="bTinyTree" value="true"/><advancedProperties name="bUseDTD" value="false"/><advancedProperties name="bWarnings" value="true"/></scenario></scenarios><MapperMetaTag><MapperInfo srcSchemaPathIsRelative="yes" srcSchemaInterpretAsXML="no" destSchemaPath="" destSchemaRoot="" destSchemaPathIsRelative="yes" destSchemaInterpretAsXML="no"/><MapperBlockPosition></MapperBlockPosition><TemplateContext></TemplateContext><MapperFilter side="source"></MapperFilter></MapperMetaTag>
</metaInformation>
:)