Adjusted process function to return document node for the validate and cleanup functions.

(:
 : Copyright (C) [2013] [The FURTHeR Project]
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at
 :
 :         http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, software
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
 :)
xquery version "3.0";
module namespace frt = "http://further.utah.edu/result-translation";

(: Import FURTHeR Module :)
(: import module namespace further = "http://further.utah.edu/xquery-functions-module"
    at "further.xq"; :)
import module namespace further = 'http://further.utah.edu/xquery-functions-module'
    at '${server.mdr.ws}${path.mdr.ws.resource.path}/fqe/further/xq/further.xq';

(: Import FURTHeR Constants Module :)
(: import module namespace const = 'http://further.utah.edu/constants'
    at 'constants.xq'; :)
import module namespace const = 'http://further.utah.edu/constants'
    at '${server.mdr.ws}${path.mdr.ws.resource.path}/fqe/further/xq/constants.xq';

(: ALWAYS Define Namespaces in XQUERY PROLOG! :)
declare namespace fn  = 'http://www.w3.org/2005/xpath-functions';
declare namespace fq = "http://further.utah.edu/core/query";
declare namespace dts = 'http://further.utah.edu/dts';
declare namespace mdr = "http://further.utah.edu/mdr";
declare namespace xs = "http://www.w3.org/2001/XMLSchema";
declare namespace xsi = "http://www.w3.org/2001/XMLSchema-instance";
declare namespace fqe = 'http://further.utah.edu/fqe';
(: DO NOT USE DEFAULT NAMESPACE, it may conflict with the response Namespaces :)

(: Global CONSTANTS, Always Translating FROM FURTHeR Namespace ID :)
declare variable $frt:FURTHER as xs:string := '32769';
declare variable $frt:FURTHeR as xs:string := 'FURTHeR';

(: We are using SNOMED (Namespace ID 30) for ObservationType Values :)
declare variable $frt:SNOMED as xs:string := '30';

(: DTS Terminology Namespace IDs :)
declare variable $frt:OMOP-V2 as xs:string := '32868';
declare variable $frt:ICD-9 as xs:string := '10';
declare variable $frt:LOINC as xs:string := '5102';

(: Empty String Value for Substituting Empty Arguments to Functions :)
declare variable $frt:EMPTY as xs:string := '';

(: Mark Criterias that got Skipped :)
declare variable $frt:SKIP as xs:string := 'S';

(: Yes Value Used for Translation Flag transFlag :)
declare variable $frt:YES as xs:string := 'Y';

(: No Value Used for Translation Flag transFlag :)
declare variable $frt:NO as xs:string := 'N';

(: ERROR Value Used for Translation Flag transFlag :)
declare variable $frt:ERROR as xs:string := 'E';

(: Placeholder in case preTranslation Fails :)
declare variable $frt:ZERO as xs:string := '0';

(: DELIMITER :)
declare variable $frt:DELIMITER as xs:string := '^';

(: MDR Static Property Names CASE SENSITIVE! :)
declare variable $frt:ATTR_TRANS_FUNC as xs:string := 'ATTR_TRANS_FUNC';
declare variable $frt:ATTR_VALUE_TRANS_FUNC as xs:string := 'ATTR_VALUE_TRANS_FUNC';
declare variable $frt:ATTR_VALUE_TRANS_TO_DATA_TYPE as xs:string := 'ATTR_VALUE_TRANS_TO_DATA_TYPE';
declare variable $frt:CODING_SYSTEM as xs:string := 'CODING_SYSTEM';
declare variable $frt:EXT_PERSON as xs:string := 'EXT_PERSON';
declare variable $frt:EXT_ROOT_ID_ATTR as xs:string := 'EXT_ROOT_ID_ATTR';

declare variable $frt:pickMe as xs:string := 'pickMe';
declare variable $frt:skipATTR as xs:string := 'skipAttr';
declare variable $frt:translateCode as xs:string := 'translateCode';
declare variable $frt:ageToBirthYear as xs:string := 'ageToBirthYear';

(: DTS Static Property Names CASE SENSITIVE! :)
declare variable $frt:CodeInSource as xs:string := 'Code in Source';
declare variable $frt:LocalCode as xs:string := 'Local Code';

(:==================================================================:)
(: Main Translate Result Function                                   :)
(: Our Goal here is to construct the Target Central Model           :)
(:==================================================================:)
declare function frt:transResult($inputXML as document-node(),
                                 $extNmspcId as xs:string,
                                 $dataSetId as xs:string)
{

  (: Get the Namespace Name Using the Namespace ID :)
  let $extNmspcName := further:getNamespaceName($extNmspcId)

  (: Must Keep this Order of Processing :)

  (: Create Empty Person Template :)
  let $emptyPerson := frt:createPersonTemplate($extNmspcName)

  (: Initialize Empty Person Template with MDR Properties :)
  let $mdrPerson := frt:initPersonTemplate($emptyPerson,$extNmspcName)

  return

    (: Validate Initialized Template :)
    if ($mdrPerson/*[@extRootObject=$frt:ERROR]) then

		  (: Error Handling :)
		  frt:validateTemplate($mdrPerson,$extNmspcName)

    else (: Continue Processing :)

		  (: Read the Input File from External Result for Processing :)
      (: Returns a document node for the following functions :)
		  let $transResult := frt:process($mdrPerson,$inputXML,$extNmspcId,$dataSetId)

		  (: Error Handling :)
		  let $validated := frt:validate($transResult,$extNmspcName)

		  (: Call cleanup Transformation :)
		  let $cleaned := frt:cleanup($validated)

		  (: Return Final Cleaned Version :)
		  return $cleaned

};

(:==================================================================:)
(: createPersonTemplate = Create Person Template XML Format         :)
(:==================================================================:)
declare function frt:createPersonTemplate($extNmspcName as xs:string)
as document-node()
{

(: Create a Document Type Here! :)
document
{
  <Person centralRootObject="{$frt:EMPTY}" extRootObject="{$frt:EMPTY}">
    <id></id>
    <administrativeGenderNamespaceId>{$frt:SNOMED}</administrativeGenderNamespaceId>
    <administrativeGender extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></administrativeGender>
    <raceNamespaceId>{$frt:SNOMED}</raceNamespaceId>
    <race extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></race>
    <ethnicityNamespaceId>{$frt:SNOMED}</ethnicityNamespaceId>
    <ethnicity extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></ethnicity>
    <dateOfBirth extPath="{$frt:EMPTY}"></dateOfBirth>
    <birthYear extPath="{$frt:EMPTY}"></birthYear>
    <birthMonth extPath="{$frt:EMPTY}"></birthMonth>
    <birthDay extPath="{$frt:EMPTY}"></birthDay>
    <educationLevel extPath="{$frt:EMPTY}"></educationLevel>
    <primaryLanguageNamespaceId>{$frt:SNOMED}</primaryLanguageNamespaceId>
    <primaryLanguage extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></primaryLanguage>
    <maritalStatusNamespaceId>{$frt:SNOMED}</maritalStatusNamespaceId>
    <maritalStatus extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></maritalStatus>
    <religionNamespaceId>{$frt:SNOMED}</religionNamespaceId>
    <religion extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></religion>
    <multipleBirthIndicator extPath="{$frt:EMPTY}"></multipleBirthIndicator>
    <multipleBirthIndicatorOrderNumber extPath="{$frt:EMPTY}"></multipleBirthIndicatorOrderNumber>
    <causeOfDeathNamespaceId>{$frt:SNOMED}</causeOfDeathNamespaceId>
    <causeOfDeath extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></causeOfDeath>
    <dateOfDeath extPath="{$frt:EMPTY}"></dateOfDeath>
    <deathYear extPath="{$frt:EMPTY}"></deathYear>
    <pedigreeQuality extPath="{$frt:EMPTY}"></pedigreeQuality>
  </Person>
}

(: END Function :)
};

(:==================================================================:)
(: initPersonTemplate = Create Person Template XML Format           :)
(:==================================================================:)
declare function frt:initPersonTemplate($emptyPerson as document-node(),
                                        $extNmspcName as xs:string)
as document-node()
{

(: BEGIN XQUERY TRANSFORMATION :)
(: Make a copy of the entire Document :)
copy $inputCopy := $emptyPerson
modify (

  (: Find the Central Root Object :)
  (: The Name of the Root Element is the Name of the Central Root Object :)
  let $centralRootObject := fn:name($inputCopy/child::node())
  return (

    (: Set the Central Root Object XML Attribute :)
    replace value of node $inputCopy//@centralRootObject with $centralRootObject

    , (: DO MORE STUFF :)

    (: Find the External Root Object to Use as a Reference Point for External XML Doc :)
    let $extRootObject := frt:getExtRootObject($centralRootObject,$extNmspcName)
    return
      replace value of node $inputCopy//@extRootObject with $extRootObject

    , (: DO MORE STUFF :)

    (: Populate the extPath XML Attributes in the Template from MDR :)
    for $centralAttr in $inputCopy//*[@extPath=$frt:EMPTY]
      let $extPath := frt:getExtPath(name($centralAttr),$frt:FURTHeR,$extNmspcName)
      return replace value of node $centralAttr/@extPath with $extPath

    , (: DO MORE STUFF :)

    (: Set DTS Translation Instruction from MDR :)
    for $dtsAttr in $inputCopy//*[@dtsFlag]
      let $dtsFlag := frt:getDTSFlag(name($dtsAttr),$frt:FURTHeR,$extNmspcName)
      return replace value of node $dtsAttr/@dtsFlag with $dtsFlag

  ) (: End Return :)

) (: End Modify :)
return $inputCopy

(: END Function :)
};

(:==================================================================:)
(: validateTemplate (Error Handling)                                :)
(:==================================================================:)
declare function frt:validateTemplate($inputXML,$srcNmspcName as xs:string)
as document-node()
{

(: BEGIN XQUERY TRANSFORMATION :)
(: Make a copy of the entire Document :)
copy $inputCopy := $inputXML
modify (

  if ($inputCopy/*[@extRootObject=$frt:ERROR]) then

    (: Get Name of the XML Root Node (Central Root Object) :)
    let $attrName := fn:name($inputCopy/*[@extRootObject=$frt:ERROR])
    return
    (: replace ONLY Works when we are Referring to a Document Type (NOT Element Type) :)
    replace node $inputCopy/*
       with
       <error xmlns="http://further.utah.edu/core/ws">
         MDR_RESULT_TRANSLATION_ERROR
         <message>MDR Association for [ {$srcNmspcName}.{$attrName} ] May be Missing</message>
       </error>

  else ()

) (: End Modify :)
return $inputCopy

(: END Function :)
};

(:==================================================================:)
(: process = Processing Function                                    :)
(:==================================================================:)
declare function frt:process($mdrPerson,$extXML,$extNmspcId,$dataSetId)
{

  (: High Level WorkFlow
	  1) Find the rootObject in the External Model by using the extRootObject Attribute Hint
	  2) For each rootObject in the External Model, create a mdrPerson Node and populate it with DTS Translated Data
	  3) Replace the <id> node with getPersonId function
	  4) Place the full result in a <ResultList> node
  :)

  (: Get External Root Object :)
  let $extRootObject := fn:substring-before($mdrPerson//@extRootObject,$frt:DELIMITER)

  (: Loop to Return ALL External Root Objects :)
  return
  document{
  <ResultList>
    {
      for $extRoot at $i in $extXML/ResultList/*[fn:name()=$extRootObject]
      (: debug
         return $extRootObject :)
      return frt:transPerson($mdrPerson,$extRoot,$extNmspcId,$dataSetId)
    }
  </ResultList>
  }

(: END Function :)
};

(:==================================================================:)
(: transPerson = Translate Single Person                            :)
(:==================================================================:)
declare function frt:transPerson($mdrPerson,$extPerson,$extNmspcId,$dataSetId)
as document-node()
{

(:
1) Get Data from External Input File and Populate our Template
2) Get DTS Translated Data if necessary
3) Replace the <id> node with getPersonId function
:)

(: BEGIN XQUERY TRANSFORMATION :)
copy $transFields := $mdrPerson
modify (

  (: Get Data from External Person :)
  for $field in $transFields//*[@extPath != $frt:EMPTY]
    (: Get the External Field Value using Dynamic Evaluation Function :)
    (: Full Path should be starting from under the rootObject node :)
    (: Create a String to represent the Full Document Path :)
    let $s := concat("$doc",$field/@extPath)
    (: Evaluate the String with a mapping to the document/element :)
    (: Took long time to figure this out, it is amazing when it works! :)
    let $extValue := xquery:eval($s,map {"doc" := $extPerson})
    let $cnt := fn:count($extValue)
    return (
	    if ( $cnt > 1 ) then
		    insert node attribute multiError {$cnt} into $field
	      else
        replace value of node $field with $extValue
    )

) (: End Modify :)
return

(: BEGIN XQUERY TRANSFORMATION :)
copy $transDTS := $transFields
modify (

  (: Get Data from External Person :)
  for $field in $transDTS//*[@dtsFlag=$frt:translateCode]

    let $dtsSrcPropVal := $field/text()
    let $tgTerm := $field/@dtsTerm

    (: Call DTS :)
    let $dtsResponse := further:getTranslatedConcept($extNmspcId,
                                                     $frt:LocalCode,
                                                     $dtsSrcPropVal,
                                                     $tgTerm,
                                                     $frt:CodeInSource)
    (: DEBUG DTS URL :)
    (: let $dtsURL := further:getConceptTranslationRestUrl($extNmspcId,
                                                        $frt:LocalCode,
                                                        $dtsSrcPropVal,
                                                        $tgTerm,
                                                        $frt:CodeInSource) :)

    (: Get Translated Value :)
    let $translatedPropVal := further:getConceptPropertyValue($dtsResponse)

    return
      if ($translatedPropVal) then (
        replace value of node $field with $translatedPropVal
        ,
        replace value of node $field/@dtsFlag with $frt:YES
      )
      else
        (: Always return Error if there is no DTS Mapping :)
        replace value of node $field/@dtsFlag with $frt:ERROR

) (: End Modify :)
return

(: BEGIN XQUERY TRANSFORMATION :)
copy $transRootId := $transDTS
modify (

  (: Find the External Root Object & Root Object Attr :)
  let $extRootObject := fn:substring-before($transRootId//@extRootObject,$frt:DELIMITER)
  let $extRootObjectAttr := fn:substring-after($transRootId//@extRootObject,$frt:DELIMITER)
  return
    replace node $transRootId//id
       with frt:getPersonId($extNmspcId,$extPerson,$extRootObject,$extRootObjectAttr,$dataSetId)

) (: End Modify :)
return $transRootId

(: END Function :)
};

(:==================================================================:)
(: Validate (Error Handling)                                        :)
(:==================================================================:)
declare function frt:validate($inputXML as document-node(),$srcNmspcName as xs:string)
as document-node()
{
(: BEGIN XQUERY TRANSFORMATION :)
(: Make a copy of the entire Document :)
copy $inputCopy := $inputXML
modify (

  (: Error out ONLY the FIRST criteria AttributeName :)
  (: This will ensure that the output xml is valid since there is no outter <errors> node at this time :)
  (: It will also prevent us from having a very long list of errors :)
  (: Within the for statement, be sure to use the parentheses after the in clause.
     Therefore, the position predicate[1] will function properly.
     if we take out the parentheses and the [1], we will list the all criterias with error.
     which we may want in the future. :)

  if ($inputCopy//*[@dtsFlag=$frt:ERROR]) then (

    (: Return the First Criteria that Errored so we do not have a long list of Errors :)
    for $field in ($inputCopy//*[@dtsFlag=$frt:ERROR])[1]
    let $attrName := fn:name($field)
      return
      replace node $inputCopy/*
         with
         <error xmlns="http://further.utah.edu/core/ws">
           DTS_RESULT_TRANSLATION_ERROR
           <message>DTS Mapping for [ {$srcNmspcName}.{$attrName} ] May be Missing</message>
         </error>
  )
  else(
    (: Remove ALL Nodes that have been Marked to be SKIPPED :)
    delete node $inputCopy//*[@extPath=$frt:SKIP]
  ) (: End IF-Else Statement :)

) (: End Modify :)
return $inputCopy

(: END Function :)
};

(:==================================================================:)
(: Cleanup                                                          :)
(:==================================================================:)
declare function frt:cleanup($inputXML)
{

(: BEGIN XQUERY TRANSFORMATION :)
copy $inputCopy1 := $inputXML
modify (

  (: Remove ALL Empty Data Nodes :)
  for $node in $inputCopy1//*[@extPath=$frt:EMPTY]
    return delete node $node

  , (: Delete ALL tranFlag Attributes on SUCCESS :)
  delete node $inputCopy1//@extRootObject,
  delete node $inputCopy1//@centralRootObject,
  delete node $inputCopy1//@extPath,
  delete node $inputCopy1//@dtsTerm,
  delete node $inputCopy1//@dtsFlag

) (: End Modify :)
return

(: BEGIN XQUERY TRANSFORMATION :)
copy $inputCopy2 := $inputCopy1
modify (

  (: Remove ALL Empty Namespace Nodes :)
	(: Loop through Each Person rootObject :)
	for $person in $inputCopy2/ResultList/Person

	  (: For ALL Namespace Nodes :)
	  for $nmspcNode in $person//*[fn:contains(fn:name(),'NamespaceId')]

	    (: Get the coresponding data node name :)
	    let $dataNodeName := fn:substring-before(fn:name($nmspcNode),'NamespaceId')

	    return (:insert node attribute debug {$dataNodeName} into $nmspcNode:)
	      (: Remove ALL Namespace Nodes if coresponding dataNode does NOT exist :)
        if (fn:not(fn:exists($person//*[fn:name()=$dataNodeName]))) then
	        delete node $nmspcNode
	      else()

) (: End Modify :)
return $inputCopy2

(: END Function :)
};

(:=====================================================================:)
(: Sanitize SINGLE & DOUBLE Quotes to Prevent XQuery Injection Attacks :)
(:=====================================================================:)
declare function frt:sanitize($inputXML as document-node())
as document-node()
{

(: Ideally, I want to replace all '&' characters with '&'
   However, BaseX does not allow me to have this character in the xml file or output.
   So I am skipping this for now :)

(: Transformation to replace Single Quotes with ''' :)
copy $inputCopy := $inputXML
modify (

  for $node at $i in $inputCopy//*[contains(text(),'''')]
  return
    replace value of node $node with replace($node, '''','&apos;')

) (: End Modify :)

return
(: Starting another Transformation, so the replace node will not conflict :)
(: Transformation to replace Double Quotes with '"' :)
copy $inputCopy2 := $inputCopy
modify (

  for $node at $i in $inputCopy2//*[contains(text(),"""")]
  return
    replace value of node $node with replace($node, """",'&quot;')

) (: End Modify :)
return $inputCopy2

}; (: END OF FUNCTION frt:sanitize :)

(:=====================================================================:)
(: getPersonId = Construct the group of Person ID Tags                 :)
(:=====================================================================:)
declare function frt:getPersonId($extNmspcId,$extPerson,$extRootObject,$extRootObjectAttr,$dataSetId)
{
  (: Get the External ID Value :)
  let $s := concat("$doc/",$extRootObjectAttr)

  (: Evaluate the String with a mapping to the document/element :)
  (: Took long time to figure this out, it is amazing when it works! :)
  let $extIdValue := xquery:eval($s,map {"doc" := $extPerson})

  let $cnt := fn:count($extIdValue)
  return (
	  if ( $cnt > 1 ) then
      <id multiError='{$cnt}'/>
	  else
		  (: Call Identity Resolution Service :)
		  (:
		    REST CAll FORMAT

		    http://demo.further.utah.edu:9000/fqe/mpi/rest/id/generate/
		    {target_object}/{target_attribute}/{source_namespace_id}/
		    {source_object}/{source_attribute}/{source_id_value}/{queryId}

		    Note:
		    For Result Translation, Target is always the Central Model (FURTHER Model)
		    The Source is the External Data Source Models

		    Examples:
http://demo.further.utah.edu:9000/fqe/mpi/rest/id/generate/PERSON/FPERSON_ID/32868/PERSON/PERSONID/12345/862c9130-0e89-11e3-bb9f-f23c91aec05e
http://demo.further.utah.edu:9000/fqe/mpi/rest/id/generate/PERSON/FPERSON_ID/32776/PATIENT/PAT_DE_ID/12345/862c9130-0e89-11e3-bb9f-f23c91aec05e
		  :)

      (: Built the REST URL :)
		  let $baseURL := fn:concat($const:fqeRestServer,'/mpi/rest/id/generate/PERSON/FPERSON_ID/')
		  let $docUrl := fn:concat($baseURL, $extNmspcId, '/', $extRootObject, '/' , $extRootObjectAttr , '/', $extIdValue , '/', $dataSetId)

		  (: Prevent XQuery Injection Attacks :)
		  let $parsedDocUrl := iri-to-uri($docUrl)
		  let $result := doc($parsedDocUrl)

		  (: Strip out the Person ID from the Result :)
		  (: let $resolvedPersonId := $result//fqe:value/text() :)
		  let $resolvedPersonId := $result/fqe:id/fqe:value/text()

		  return (

        (: DEBUG with trace :)
        (: trace($resolvedPersonId, 'ResolvedPersonID'), :)

				<id>
				  <datasetId>{$dataSetId}</datasetId>
		      <id>{$resolvedPersonId}</id>
			  </id>
			  ,
			  <compositeId>{$dataSetId}:{$resolvedPersonId}</compositeId>
		  )

  ) (: End of Return :)

}; (: END OF FUNCTION :)

(:==================================================================:)
(: getLeftAssoc = Get Left Assocation from MDR                      :)
(:==================================================================:)
declare function frt:getLeftAssoc(
                 $leftAttrName as xs:string,
                 $leftNmspcName as xs:string,
                 $rightNmspcName as xs:string)
{
  (: EXAMPLE: ${server.dts.ws}/mdr/rest/asset/association/left/translatesTo/genderConceptId :)
  (:          ${server.dts.ws}/mdr/rest/asset/association/left/translatesTo/{sourceAttr} :)
  (:          http://demo.further.utah.edu:9000/mdr/rest/asset/association/left/translatesTo/administrativeGender :)
  let $baseURL := fn:concat($const:fmdrRestServer,'/rest/asset/association/left/translatesTo/')
  let $docUrl := fn:concat( $baseURL, $leftAttrName )

  (: Prevent XQuery Injection Attacks :)
  let $parsedDocUrl := iri-to-uri( $docUrl )
  let $doc := doc($parsedDocUrl)

  (: Return the AssetAssociation for the Correct Namespaces :)
  return

    if (fn:count($doc//assetAssociation[rightNamespace=$rightNmspcName and leftNamespace=$leftNmspcName]) > 1) then
      $doc//assetAssociation[rightNamespace=$rightNmspcName and leftNamespace=$leftNmspcName and properties/entry/value=$frt:pickMe]
    else
      $doc//assetAssociation[rightNamespace=$rightNmspcName and leftNamespace=$leftNmspcName]

};

(:==================================================================:)
(: getExtPath = GET XPath of XML Element in External XML from MDR   :)
(:==================================================================:)
declare function frt:getExtPath(
                 $leftAttrName as xs:string,
                 $leftNmspcName as xs:string,
                 $rightNmspcName as xs:string)
{
  let $leftAssoc := frt:getLeftAssoc($leftAttrName,$leftNmspcName,$rightNmspcName)

  (: Extract Out the External XPath Value :)
  for $entry in $leftAssoc/properties/entry[key='RESULT_PATH']
  return
    if ($entry) then $entry/value
    else $frt:EMPTY

};

(:==================================================================:)
(: getDTSFlag = GET DTS Instruction for External XML from MDR       :)
(:==================================================================:)
declare function frt:getDTSFlag(
                 $leftAttrName as xs:string,
                 $leftNmspcName as xs:string,
                 $rightNmspcName as xs:string)
{
  let $leftAssoc := frt:getLeftAssoc($leftAttrName,$leftNmspcName,$rightNmspcName)

  (: Extract Out the External XPath Value :)
  for $entry in $leftAssoc/properties/entry[key=$frt:ATTR_VALUE_TRANS_FUNC]
  return
    if ($entry) then $entry/value
    else $frt:EMPTY

};

(:==================================================================:)
(: getExtRootObject = GET External rootObject from MDR              :)
(:==================================================================:)
declare function frt:getExtRootObject(
                 $centralRootObject as xs:string,
                 $extNmspcName as xs:string
                 )
{

  let $leftAssoc := frt:getLeftAssoc($centralRootObject,$frt:FURTHeR,$extNmspcName)

  return

    (: if there is an Association Result :)
    if ($leftAssoc/properties/entry[key=$frt:EXT_ROOT_ID_ATTR]) then

      (: Get the External Root Object:)
      let $extRootObject := $leftAssoc/rightAsset/text()

      (: Get the External Root Object ID Attribute :)
      let $extRootObjectAttr :=
        for $entry in $leftAssoc/properties/entry[key=$frt:EXT_ROOT_ID_ATTR]
          return $entry/value/text()

      (: Return Concatenated String :)
      return concat($extRootObject,$frt:DELIMITER,$extRootObjectAttr)

    else $frt:ERROR

};

(:==================================================================:)
(: printDebug = Print Debug Variable to Query Info Screen           :)
(:==================================================================:)
declare function frt:printDebug($debugVar,$msg as xs:string?)
{
  let $var := $debugVar
  return fn:trace( $var,concat('DEBUG ', $msg, '=') )
};

(:==================================================================:)
(: ageToBirthYear = Translate Age to BirthYear                      :)
(:==================================================================:)
declare function frt:ageToBirthYear($age)
{
  (: Get Current Year :)
  let $curYear := year-from-date(current-date())

  (: Subtract Age from CurrentYear to Get BirthYear :)
  return $curYear - $age
};

(: END OF MODULE :)

(:
 : Copyright (C) [2013] [The FURTHeR Project]
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at
 :
 :         http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, software
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
 :)
xquery version "3.0";
module namespace frt = "http://further.utah.edu/result-translation";

(: Import FURTHeR Module :)
(: import module namespace further = "http://further.utah.edu/xquery-functions-module"
    at "further.xq"; :)
import module namespace further = 'http://further.utah.edu/xquery-functions-module'
    at '${server.mdr.ws}${path.mdr.ws.resource.path}/fqe/further/xq/further.xq';

(: Import FURTHeR Constants Module :)
(: import module namespace const = 'http://further.utah.edu/constants'
    at 'constants.xq'; :)
import module namespace const = 'http://further.utah.edu/constants'
    at '${server.mdr.ws}${path.mdr.ws.resource.path}/fqe/further/xq/constants.xq';

(: ALWAYS Define Namespaces in XQUERY PROLOG! :)
declare namespace fn  = 'http://www.w3.org/2005/xpath-functions';
declare namespace fq = "http://further.utah.edu/core/query";
declare namespace dts = 'http://further.utah.edu/dts';
declare namespace mdr = "http://further.utah.edu/mdr";
declare namespace xs = "http://www.w3.org/2001/XMLSchema";
declare namespace xsi = "http://www.w3.org/2001/XMLSchema-instance";
declare namespace fqe = 'http://further.utah.edu/fqe';
(: DO NOT USE DEFAULT NAMESPACE, it may conflict with the response Namespaces :)

(: Global CONSTANTS, Always Translating FROM FURTHeR Namespace ID :)
declare variable $frt:FURTHER as xs:string := '32769';
declare variable $frt:FURTHeR as xs:string := 'FURTHeR';

(: We are using SNOMED (Namespace ID 30) for ObservationType Values :)
declare variable $frt:SNOMED as xs:string := '30';

(: DTS Terminology Namespace IDs :)
declare variable $frt:OMOP-V2 as xs:string := '32868';
declare variable $frt:ICD-9 as xs:string := '10';
declare variable $frt:LOINC as xs:string := '5102';

(: Empty String Value for Substituting Empty Arguments to Functions :)
declare variable $frt:EMPTY as xs:string := '';

(: Mark Criterias that got Skipped :)
declare variable $frt:SKIP as xs:string := 'S';

(: Yes Value Used for Translation Flag transFlag :)
declare variable $frt:YES as xs:string := 'Y';

(: No Value Used for Translation Flag transFlag :)
declare variable $frt:NO as xs:string := 'N';

(: ERROR Value Used for Translation Flag transFlag :)
declare variable $frt:ERROR as xs:string := 'E';

(: Placeholder in case preTranslation Fails :)
declare variable $frt:ZERO as xs:string := '0';

(: DELIMITER :)
declare variable $frt:DELIMITER as xs:string := '^';

(: MDR Static Property Names CASE SENSITIVE! :)
declare variable $frt:ATTR_TRANS_FUNC as xs:string := 'ATTR_TRANS_FUNC';
declare variable $frt:ATTR_VALUE_TRANS_FUNC as xs:string := 'ATTR_VALUE_TRANS_FUNC';
declare variable $frt:ATTR_VALUE_TRANS_TO_DATA_TYPE as xs:string := 'ATTR_VALUE_TRANS_TO_DATA_TYPE';
declare variable $frt:CODING_SYSTEM as xs:string := 'CODING_SYSTEM';
declare variable $frt:EXT_PERSON as xs:string := 'EXT_PERSON';
declare variable $frt:EXT_ROOT_ID_ATTR as xs:string := 'EXT_ROOT_ID_ATTR';

declare variable $frt:pickMe as xs:string := 'pickMe';
declare variable $frt:skipATTR as xs:string := 'skipAttr';
declare variable $frt:translateCode as xs:string := 'translateCode';
declare variable $frt:ageToBirthYear as xs:string := 'ageToBirthYear';

(: DTS Static Property Names CASE SENSITIVE! :)
declare variable $frt:CodeInSource as xs:string := 'Code in Source';
declare variable $frt:LocalCode as xs:string := 'Local Code';

(:==================================================================:)
(: Main Translate Result Function                                   :)
(: Our Goal here is to construct the Target Central Model           :)
(:==================================================================:)
declare function frt:transResult($inputXML as document-node(),
                                 $extNmspcId as xs:string,
                                 $dataSetId as xs:string)
{

  (: Get the Namespace Name Using the Namespace ID :)
  let $extNmspcName := further:getNamespaceName($extNmspcId)

  (: Must Keep this Order of Processing :)

  (: Create Empty Person Template :)
  let $emptyPerson := frt:createPersonTemplate($extNmspcName)

  (: Initialize Empty Person Template with MDR Properties :)
  let $mdrPerson := frt:initPersonTemplate($emptyPerson,$extNmspcName)

  return

    (: Validate Initialized Template :)
    if ($mdrPerson/*[@extRootObject=$frt:ERROR]) then

		  (: Error Handling :)
		  frt:validateTemplate($mdrPerson,$extNmspcName)

    else (: Continue Processing :)

		  (: Read the Input File from External Result for Processing :)
		  let $transResult := frt:process($mdrPerson,$inputXML,$extNmspcId,$dataSetId)

		  (: Error Handling :)
		  let $validated := frt:validate($transResult,$extNmspcName)

		  (: Call cleanup Transformation :)
		  let $cleaned := frt:cleanup($validated)

		  (: Return Final Cleaned Version :)
		  return $cleaned

};

(:==================================================================:)
(: createPersonTemplate = Create Person Template XML Format         :)
(:==================================================================:)
declare function frt:createPersonTemplate($extNmspcName as xs:string)
as document-node()
{

(: Create a Document Type Here! :)
document
{
  <Person centralRootObject="{$frt:EMPTY}" extRootObject="{$frt:EMPTY}">
    <id></id>
    <administrativeGenderNamespaceId>{$frt:SNOMED}</administrativeGenderNamespaceId>
    <administrativeGender extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></administrativeGender>
    <raceNamespaceId>{$frt:SNOMED}</raceNamespaceId>
    <race extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></race>
    <ethnicityNamespaceId>{$frt:SNOMED}</ethnicityNamespaceId>
    <ethnicity extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></ethnicity>
    <dateOfBirth extPath="{$frt:EMPTY}"></dateOfBirth>
    <birthYear extPath="{$frt:EMPTY}"></birthYear>
    <birthMonth extPath="{$frt:EMPTY}"></birthMonth>
    <birthDay extPath="{$frt:EMPTY}"></birthDay>
    <educationLevel extPath="{$frt:EMPTY}"></educationLevel>
    <primaryLanguageNamespaceId>{$frt:SNOMED}</primaryLanguageNamespaceId>
    <primaryLanguage extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></primaryLanguage>
    <maritalStatusNamespaceId>{$frt:SNOMED}</maritalStatusNamespaceId>
    <maritalStatus extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></maritalStatus>
    <religionNamespaceId>{$frt:SNOMED}</religionNamespaceId>
    <religion extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></religion>
    <multipleBirthIndicator extPath="{$frt:EMPTY}"></multipleBirthIndicator>
    <multipleBirthIndicatorOrderNumber extPath="{$frt:EMPTY}"></multipleBirthIndicatorOrderNumber>
    <causeOfDeathNamespaceId>{$frt:SNOMED}</causeOfDeathNamespaceId>
    <causeOfDeath extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></causeOfDeath>
    <dateOfDeath extPath="{$frt:EMPTY}"></dateOfDeath>
    <deathYear extPath="{$frt:EMPTY}"></deathYear>
    <pedigreeQuality extPath="{$frt:EMPTY}"></pedigreeQuality>
  </Person>
}

(: END Function :)
};

(:==================================================================:)
(: initPersonTemplate = Create Person Template XML Format           :)
(:==================================================================:)
declare function frt:initPersonTemplate($emptyPerson as document-node(),
                                        $extNmspcName as xs:string)
as document-node()
{

(: BEGIN XQUERY TRANSFORMATION :)
(: Make a copy of the entire Document :)
copy $inputCopy := $emptyPerson
modify (

  (: Find the Central Root Object :)
  (: The Name of the Root Element is the Name of the Central Root Object :)
  let $centralRootObject := fn:name($inputCopy/child::node())
  return (

    (: Set the Central Root Object XML Attribute :)
    replace value of node $inputCopy//@centralRootObject with $centralRootObject

    , (: DO MORE STUFF :)

    (: Find the External Root Object to Use as a Reference Point for External XML Doc :)
    let $extRootObject := frt:getExtRootObject($centralRootObject,$extNmspcName)
    return
      replace value of node $inputCopy//@extRootObject with $extRootObject

    , (: DO MORE STUFF :)

    (: Populate the extPath XML Attributes in the Template from MDR :)
    for $centralAttr in $inputCopy//*[@extPath=$frt:EMPTY]
      let $extPath := frt:getExtPath(name($centralAttr),$frt:FURTHeR,$extNmspcName)
      return replace value of node $centralAttr/@extPath with $extPath

    , (: DO MORE STUFF :)

    (: Set DTS Translation Instruction from MDR :)
    for $dtsAttr in $inputCopy//*[@dtsFlag]
      let $dtsFlag := frt:getDTSFlag(name($dtsAttr),$frt:FURTHeR,$extNmspcName)
      return replace value of node $dtsAttr/@dtsFlag with $dtsFlag

  ) (: End Return :)

) (: End Modify :)
return $inputCopy

(: END Function :)
};

(:==================================================================:)
(: validateTemplate (Error Handling)                                :)
(:==================================================================:)
declare function frt:validateTemplate($inputXML,$srcNmspcName as xs:string)
as document-node()
{

(: BEGIN XQUERY TRANSFORMATION :)
(: Make a copy of the entire Document :)
copy $inputCopy := $inputXML
modify (

  if ($inputCopy/*[@extRootObject=$frt:ERROR]) then

    (: Get Name of the XML Root Node (Central Root Object) :)
    let $attrName := fn:name($inputCopy/*[@extRootObject=$frt:ERROR])
    return
    (: replace ONLY Works when we are Referring to a Document Type (NOT Element Type) :)
    replace node $inputCopy/*
       with
       <error xmlns="http://further.utah.edu/core/ws">
         MDR_RESULT_TRANSLATION_ERROR
         <message>MDR Association for [ {$srcNmspcName}.{$attrName} ] May be Missing</message>
       </error>

  else ()

) (: End Modify :)
return $inputCopy

(: END Function :)
};

(:==================================================================:)
(: process = Processing Function                                    :)
(:==================================================================:)
declare function frt:process($mdrPerson,$extXML,$extNmspcId,$dataSetId)
{

  (: High Level WorkFlow
	  1) Find the rootObject in the External Model by using the extRootObject Attribute Hint
	  2) For each rootObject in the External Model, create a mdrPerson Node and populate it with DTS Translated Data
	  3) Replace the <id> node with getPersonId function
	  4) Place the full result in a <ResultList> node
  :)

  (: Get External Root Object :)
  let $extRootObject := fn:substring-before($mdrPerson//@extRootObject,$frt:DELIMITER)

  (: Loop to Return ALL External Root Objects :)
  return
  <ResultList>
    {
      for $extRoot at $i in $extXML/ResultList/*[fn:name()=$extRootObject]
      (: debug
         return $extRootObject :)
      return frt:transPerson($mdrPerson,$extRoot,$extNmspcId,$dataSetId)
    }
  </ResultList>

(: END Function :)
};

(:==================================================================:)
(: transPerson = Translate Single Person                            :)
(:==================================================================:)
declare function frt:transPerson($mdrPerson,$extPerson,$extNmspcId,$dataSetId)
as document-node()
{

(:
1) Get Data from External Input File and Populate our Template
2) Get DTS Translated Data if necessary
3) Replace the <id> node with getPersonId function
:)

(: BEGIN XQUERY TRANSFORMATION :)
copy $transFields := $mdrPerson
modify (

  (: Get Data from External Person :)
  for $field in $transFields//*[@extPath != $frt:EMPTY]
    (: Get the External Field Value using Dynamic Evaluation Function :)
    (: Full Path should be starting from under the rootObject node :)
    (: Create a String to represent the Full Document Path :)
    let $s := concat("$doc",$field/@extPath)
    (: Evaluate the String with a mapping to the document/element :)
    (: Took long time to figure this out, it is amazing when it works! :)
    let $extValue := xquery:eval($s,map {"doc" := $extPerson})
    let $cnt := fn:count($extValue)
    return (
	    if ( $cnt > 1 ) then
		    insert node attribute multiError {$cnt} into $field
	      else
        replace value of node $field with $extValue
    )

) (: End Modify :)
return

(: BEGIN XQUERY TRANSFORMATION :)
copy $transDTS := $transFields
modify (

  (: Get Data from External Person :)
  for $field in $transDTS//*[@dtsFlag=$frt:translateCode]

    let $dtsSrcPropVal := $field/text()
    let $tgTerm := $field/@dtsTerm

    (: Call DTS :)
    let $dtsResponse := further:getTranslatedConcept($extNmspcId,
                                                     $frt:LocalCode,
                                                     $dtsSrcPropVal,
                                                     $tgTerm,
                                                     $frt:CodeInSource)
    (: DEBUG DTS URL :)
    (: let $dtsURL := further:getConceptTranslationRestUrl($extNmspcId,
                                                        $frt:LocalCode,
                                                        $dtsSrcPropVal,
                                                        $tgTerm,
                                                        $frt:CodeInSource) :)

    (: Get Translated Value :)
    let $translatedPropVal := further:getConceptPropertyValue($dtsResponse)

    return
      if ($translatedPropVal) then (
        replace value of node $field with $translatedPropVal
        ,
        replace value of node $field/@dtsFlag with $frt:YES
      )
      else
        (: Always return Error if there is no DTS Mapping :)
        replace value of node $field/@dtsFlag with $frt:ERROR

) (: End Modify :)
return

(: BEGIN XQUERY TRANSFORMATION :)
copy $transRootId := $transDTS
modify (

  (: Find the External Root Object & Root Object Attr :)
  let $extRootObject := fn:substring-before($transRootId//@extRootObject,$frt:DELIMITER)
  let $extRootObjectAttr := fn:substring-after($transRootId//@extRootObject,$frt:DELIMITER)
  return
    replace node $transRootId//id
       with frt:getPersonId($extNmspcId,$extPerson,$extRootObject,$extRootObjectAttr,$dataSetId)

) (: End Modify :)
return $transRootId

(: END Function :)
};

(:==================================================================:)
(: Validate (Error Handling)                                        :)
(:==================================================================:)
declare function frt:validate($inputXML,$srcNmspcName as xs:string)
{
(: BEGIN XQUERY TRANSFORMATION :)
(: Make a copy of the entire Document :)
copy $inputCopy := $inputXML
modify (

  (: Error out ONLY the FIRST criteria AttributeName :)
  (: This will ensure that the output xml is valid since there is no outter <errors> node at this time :)
  (: It will also prevent us from having a very long list of errors :)
  (: Within the for statement, be sure to use the parentheses after the in clause.
     Therefore, the position predicate[1] will function properly.
     if we take out the parentheses and the [1], we will list the all criterias with error.
     which we may want in the future. :)

  if ($inputCopy//*[@dtsFlag=$frt:ERROR]) then (

    (: Return the First Criteria that Errored so we do not have a long list of Errors :)
    for $field in ($inputCopy//*[@dtsFlag=$frt:ERROR])[1]
    let $attrName := fn:name($field)
      return
      replace node $inputCopy/*
         with
         <error xmlns="http://further.utah.edu/core/ws">
           DTS_RESULT_TRANSLATION_ERROR
           <message>DTS Mapping for [ {$srcNmspcName}.{$attrName} ] May be Missing</message>
         </error>
  )
  else(
    (: Remove ALL Nodes that have been Marked to be SKIPPED :)
    delete node $inputCopy//*[@extPath=$frt:SKIP]
  ) (: End IF-Else Statement :)

) (: End Modify :)
return $inputCopy

(: END Function :)
};

(:==================================================================:)
(: Cleanup                                                          :)
(:==================================================================:)
declare function frt:cleanup($inputXML)
{

(: BEGIN XQUERY TRANSFORMATION :)
copy $inputCopy1 := $inputXML
modify (

  (: Remove ALL Empty Data Nodes :)
  for $node in $inputCopy1//*[@extPath=$frt:EMPTY]
    return delete node $node

  , (: Delete ALL tranFlag Attributes on SUCCESS :)
  delete node $inputCopy1//@extRootObject,
  delete node $inputCopy1//@centralRootObject,
  delete node $inputCopy1//@extPath,
  delete node $inputCopy1//@dtsTerm,
  delete node $inputCopy1//@dtsFlag

) (: End Modify :)
return

(: BEGIN XQUERY TRANSFORMATION :)
copy $inputCopy2 := $inputCopy1
modify (

  (: Remove ALL Empty Namespace Nodes :)
	(: Loop through Each Person rootObject :)
	for $person in $inputCopy2/Person

	  (: For ALL Namespace Nodes :)
	  for $nmspcNode in $person//*[fn:contains(fn:name(),'NamespaceId')]

	    (: Get the coresponding data node name :)
	    let $dataNodeName := fn:substring-before(fn:name($nmspcNode),'NamespaceId')

	    return (:insert node attribute debug {$dataNodeName} into $nmspcNode:)
	      (: Remove ALL Namespace Nodes if coresponding dataNode does NOT exist :)
        if (fn:not(fn:exists($person//*[fn:name()=$dataNodeName]))) then
	        delete node $nmspcNode
	      else()

) (: End Modify :)
return $inputCopy2

(: END Function :)
};

(:=====================================================================:)
(: Sanitize SINGLE & DOUBLE Quotes to Prevent XQuery Injection Attacks :)
(:=====================================================================:)
declare function frt:sanitize($inputXML as document-node())
as document-node()
{

(: Ideally, I want to replace all '&' characters with '&'
   However, BaseX does not allow me to have this character in the xml file or output.
   So I am skipping this for now :)

(: Transformation to replace Single Quotes with ''' :)
copy $inputCopy := $inputXML
modify (

  for $node at $i in $inputCopy//*[contains(text(),'''')]
  return
    replace value of node $node with replace($node, '''','&apos;')

) (: End Modify :)

return
(: Starting another Transformation, so the replace node will not conflict :)
(: Transformation to replace Double Quotes with '"' :)
copy $inputCopy2 := $inputCopy
modify (

  for $node at $i in $inputCopy2//*[contains(text(),"""")]
  return
    replace value of node $node with replace($node, """",'&quot;')

) (: End Modify :)
return $inputCopy2

}; (: END OF FUNCTION frt:sanitize :)

(:=====================================================================:)
(: getPersonId = Construct the group of Person ID Tags                 :)
(:=====================================================================:)
declare function frt:getPersonId($extNmspcId,$extPerson,$extRootObject,$extRootObjectAttr,$dataSetId)
{
  (: Get the External ID Value :)
  let $s := concat("$doc/",$extRootObjectAttr)

  (: Evaluate the String with a mapping to the document/element :)
  (: Took long time to figure this out, it is amazing when it works! :)
  let $extIdValue := xquery:eval($s,map {"doc" := $extPerson})

  let $cnt := fn:count($extIdValue)
  return (
	  if ( $cnt > 1 ) then
      <id multiError='{$cnt}'/>
	  else
		  (: Call Identity Resolution Service :)
		  (:
		    REST CAll FORMAT

		    http://demo.further.utah.edu:9000/fqe/mpi/rest/id/generate/
		    {target_object}/{target_attribute}/{source_namespace_id}/
		    {source_object}/{source_attribute}/{source_id_value}/{queryId}

		    Note:
		    For Result Translation, Target is always the Central Model (FURTHER Model)
		    The Source is the External Data Source Models

		    Examples:
http://demo.further.utah.edu:9000/fqe/mpi/rest/id/generate/PERSON/FPERSON_ID/32868/PERSON/PERSONID/12345/862c9130-0e89-11e3-bb9f-f23c91aec05e
http://demo.further.utah.edu:9000/fqe/mpi/rest/id/generate/PERSON/FPERSON_ID/32776/PATIENT/PAT_DE_ID/12345/862c9130-0e89-11e3-bb9f-f23c91aec05e
		  :)

      (: Built the REST URL :)
		  let $baseURL := fn:concat($const:fqeRestServer,'/mpi/rest/id/generate/PERSON/FPERSON_ID/')
		  let $docUrl := fn:concat($baseURL, $extNmspcId, '/', $extRootObject, '/' , $extRootObjectAttr , '/', $extIdValue , '/', $dataSetId)

		  (: Prevent XQuery Injection Attacks :)
		  let $parsedDocUrl := iri-to-uri($docUrl)
		  let $result := doc($parsedDocUrl)

		  (: Strip out the Person ID from the Result :)
		  (: let $resolvedPersonId := $result//fqe:value/text() :)
		  let $resolvedPersonId := $result/fqe:id/fqe:value/text()

		  return (

        (: DEBUG with trace :)
        (: trace($resolvedPersonId, 'ResolvedPersonID'), :)

				<id>
				  <datasetId>{$dataSetId}</datasetId>
		      <id>{$resolvedPersonId}</id>
			  </id>
			  ,
			  <compositeId>{$dataSetId}:{$resolvedPersonId}</compositeId>
		  )

  ) (: End of Return :)

}; (: END OF FUNCTION :)

(:==================================================================:)
(: getLeftAssoc = Get Left Assocation from MDR                      :)
(:==================================================================:)
declare function frt:getLeftAssoc(
                 $leftAttrName as xs:string,
                 $leftNmspcName as xs:string,
                 $rightNmspcName as xs:string)
{
  (: EXAMPLE: ${server.dts.ws}/mdr/rest/asset/association/left/translatesTo/genderConceptId :)
  (:          ${server.dts.ws}/mdr/rest/asset/association/left/translatesTo/{sourceAttr} :)
  (:          http://demo.further.utah.edu:9000/mdr/rest/asset/association/left/translatesTo/administrativeGender :)
  let $baseURL := fn:concat($const:fmdrRestServer,'/rest/asset/association/left/translatesTo/')
  let $docUrl := fn:concat( $baseURL, $leftAttrName )

  (: Prevent XQuery Injection Attacks :)
  let $parsedDocUrl := iri-to-uri( $docUrl )
  let $doc := doc($parsedDocUrl)

  (: Return the AssetAssociation for the Correct Namespaces :)
  return

    if (fn:count($doc//assetAssociation[rightNamespace=$rightNmspcName and leftNamespace=$leftNmspcName]) > 1) then
      $doc//assetAssociation[rightNamespace=$rightNmspcName and leftNamespace=$leftNmspcName and properties/entry/value=$frt:pickMe]
    else
      $doc//assetAssociation[rightNamespace=$rightNmspcName and leftNamespace=$leftNmspcName]

};

(:==================================================================:)
(: getExtPath = GET XPath of XML Element in External XML from MDR   :)
(:==================================================================:)
declare function frt:getExtPath(
                 $leftAttrName as xs:string,
                 $leftNmspcName as xs:string,
                 $rightNmspcName as xs:string)
{
  let $leftAssoc := frt:getLeftAssoc($leftAttrName,$leftNmspcName,$rightNmspcName)

  (: Extract Out the External XPath Value :)
  for $entry in $leftAssoc/properties/entry[key='RESULT_PATH']
  return
    if ($entry) then $entry/value
    else $frt:EMPTY

};

(:==================================================================:)
(: getDTSFlag = GET DTS Instruction for External XML from MDR       :)
(:==================================================================:)
declare function frt:getDTSFlag(
                 $leftAttrName as xs:string,
                 $leftNmspcName as xs:string,
                 $rightNmspcName as xs:string)
{
  let $leftAssoc := frt:getLeftAssoc($leftAttrName,$leftNmspcName,$rightNmspcName)

  (: Extract Out the External XPath Value :)
  for $entry in $leftAssoc/properties/entry[key=$frt:ATTR_VALUE_TRANS_FUNC]
  return
    if ($entry) then $entry/value
    else $frt:EMPTY

};

(:==================================================================:)
(: getExtRootObject = GET External rootObject from MDR              :)
(:==================================================================:)
declare function frt:getExtRootObject(
                 $centralRootObject as xs:string,
                 $extNmspcName as xs:string
                 )
{

  let $leftAssoc := frt:getLeftAssoc($centralRootObject,$frt:FURTHeR,$extNmspcName)

  return

    (: if there is an Association Result :)
    if ($leftAssoc/properties/entry[key=$frt:EXT_ROOT_ID_ATTR]) then

      (: Get the External Root Object:)
      let $extRootObject := $leftAssoc/rightAsset/text()

      (: Get the External Root Object ID Attribute :)
      let $extRootObjectAttr :=
        for $entry in $leftAssoc/properties/entry[key=$frt:EXT_ROOT_ID_ATTR]
          return $entry/value/text()

      (: Return Concatenated String :)
      return concat($extRootObject,$frt:DELIMITER,$extRootObjectAttr)

    else $frt:ERROR

};

(:==================================================================:)
(: printDebug = Print Debug Variable to Query Info Screen           :)
(:==================================================================:)
declare function frt:printDebug($debugVar,$msg as xs:string?)
{
  let $var := $debugVar
  return fn:trace( $var,concat('DEBUG ', $msg, '=') )
};

(:==================================================================:)
(: ageToBirthYear = Translate Age to BirthYear                      :)
(:==================================================================:)
declare function frt:ageToBirthYear($age)
{
  (: Get Current Year :)
  let $curYear := year-from-date(current-date())

  (: Subtract Age from CurrentYear to Get BirthYear :)
  return $curYear - $age
};

(: END OF MODULE :)


Corrected the XQDoc generated XHTML: signatures not computed correctly.

module namespace xhtml = "http://www.zorba-xquery.com/modules/internal/xqdoc-xhtml";

import module namespace util = "http://www.zorba-xquery.com/zorba/util-functions";

declare namespace xqdoc = "http://www.xqdoc.org/1.0";

declare function xhtml:doc($xqdoc)
{
    {
        xhtml:header($xqdoc),
        xhtml:body($xqdoc)
    }
};

declare function xhtml:header($xqdoc)
{

        <title>Documentation for {xhtml:module-uri($xqdoc)}</title>
        <link rel="stylesheet" type="text/css" href="" />

};

declare function xhtml:body($xqdoc)
{

{xhtml:module-uri($xqdoc)}

        {
            xhtml:module-description($xqdoc/xqdoc:module),
            xhtml:module-variables($xqdoc/xqdoc:variables),
            xhtml:module-function-summary($xqdoc/xqdoc:functions),
            xhtml:module-functions($xqdoc/xqdoc:functions)
        }

};

declare function xhtml:module-uri($xqdoc) as xs:string
{
    $xqdoc/xqdoc:module/xqdoc:uri/text()
};

declare function xhtml:parameters($comment) {
    let $params := $comment/xqdoc:param
    return
        if (exists($params)) then (

Parameters:
,
            for $param in $params
            let $text := data($param/text())
            return
                if (starts-with($text, "$")) then
                    let $name := substring-before($text, " ")
                    let $description := substring-after($text, " ")
                    return

                            {$name}
                             -
                            {$description}

                else
                    ()
        ) else ()
};

declare function xhtml:annotations($comment) {
    let $annotations := $comment/xqdoc:*[not((local-name(.) = ("description", "param", "return")))]
    return
        for $annotation in $annotations
        return (

{
                let $annName := local-name($annotation)
                return
                    if ($annName = "error")
                        then "Errors:"
                        else concat(upper-case(substring($annName, 1, 1)), substring($annName, 2), ":")
            }
,

{$annotation/text()}

        )
};

declare function xhtml:return($comment) {
    let $return := $comment/xqdoc:return
    return
        if (exists($return)) then (

Returns:
,

{$return/text()}

        ) else ()
};

declare function xhtml:description($comment)
{

{
        if($comment/xqdoc:description) then
            {replace($comment/xqdoc:description/text(), "\n", "<br />")}
        else
            "No description available."
     }

};

declare function xhtml:module-description($module)
{
    (
Module Description
,
     xhtml:description($module/xqdoc:comment),
     xhtml:annotations($module/xqdoc:comment))
};

declare function xhtml:module-variables($variables)
{
    (
Variables
,
    if(count($variables/xqdoc:variable)) then
        for $variable in $variables/xqdoc:variable
        return (
{$variable/xqdoc:uri}
,
                xhtml:description($variable/xqdoc:comment),
                xhtml:annotations($variable/xqdoc:comment))
    else

No variables declared.

    )
};

declare function xhtml:module-function-summary($functions)
{

Function Summary
,
    if(count($functions/xqdoc:function)) then

{
            for $function in $functions/xqdoc:function
            let $name := $function/xqdoc:name/text(),
                $signature := $function/xqdoc:signature/text(),
                $param-number := count(tokenize($signature, "\$")) - 1
            order by $name, $param-number
            return
                let $type := normalize-space(substring-after(substring-before($signature, "function"), "declare")),
                    $isExternal := ends-with($signature, "external"),
                    $paramsAndReturn :=
                        let $searchCrit := concat(":", $name)
                        return
                            if ($isExternal)
                                then normalize-space(substring-before(substring-after($signature, $searchCrit), "external"))
                                else normalize-space(substring-after($signature, $searchCrit))
                return

                        {$type}

{$name}{$paramsAndReturn}

        }

    else

No functions declared.

};

declare function xhtml:module-functions($functions) {
    if(count($functions/xqdoc:function)) then (

Functions
,
        for $function in $functions/xqdoc:function
        let $name := $function/xqdoc:name/text(),
            $signature := $function/xqdoc:signature/text(),
            $param-number := count(tokenize($signature, "\$")) - 1,
            $comment := $function/xqdoc:comment
        return (

{$name}
,

{xhtml:split-function-signature($signature)}
,
            xhtml:description($comment),
            xhtml:parameters($comment),
            xhtml:return($comment),
            xhtml:annotations($comment),

)
         )
    else ()
};

declare function xhtml:split-function-signature($signature as xs:string) {
    let $line1 := substring-before($signature, "(")
    let $rest := substring-after($signature, "(")
    let $params :=
        (: if the function has parameter :)
        if (matches($rest, "\$")) then
            let $tmp := substring-before($rest, ") as ")
            return
                (: if we don't have a return type specified :)
                if ($tmp eq "") then
                    (: en external function declaration :)
                    if (ends-with($rest, ") external")) then
                        substring-before($rest, ") external")
                    (: no external function :)
                    else
                        $rest
                (: the return type is specified :)
                else
                    $tmp
        (: no parameters :)
        else
            ""
    let $after := substring-after($signature, concat($params, ")"))
    return (
        concat($line1, " ("),

,
        for $param at $pos in tokenize($params, "\$")
        where $pos > 1
        return (
            concat("            $", normalize-space($param)),

        ),
        concat(")", $after)
    )
};

module namespace xhtml = "http://www.zorba-xquery.com/modules/internal/xqdoc-xhtml";

import module namespace util = "http://www.zorba-xquery.com/zorba/util-functions";

declare namespace xqdoc = "http://www.xqdoc.org/1.0";

declare function xhtml:doc($xqdoc)
{
    {
        xhtml:header($xqdoc),
        xhtml:body($xqdoc)
    }
};

declare function xhtml:header($xqdoc)
{

        <title>Documentation for {xhtml:module-uri($xqdoc)}</title>
        <link rel="stylesheet" type="text/css" href="" />

};

declare function xhtml:body($xqdoc)
{

{xhtml:module-uri($xqdoc)}

        {
            xhtml:module-description($xqdoc/xqdoc:module),
            xhtml:module-variables($xqdoc/xqdoc:variables),
            xhtml:module-function-summary($xqdoc/xqdoc:functions),
            xhtml:module-functions($xqdoc/xqdoc:functions)
        }

};

declare function xhtml:module-uri($xqdoc) as xs:string
{
    $xqdoc/xqdoc:module/xqdoc:uri/text()
};

declare function xhtml:parameters($comment) {
    let $params := $comment/xqdoc:param
    return
        if (exists($params)) then (

Parameters:
,
            for $param in $params
            let $text := data($param/text())
            return
                if (starts-with($text, "$")) then
                    let $name := substring-before($text, " ")
                    let $description := substring-after($text, " ")
                    return

                            {$name}
                             -
                            {$description}

                else
                    ()
        ) else ()
};

declare function xhtml:annotations($comment) {
    let $annotations := $comment/xqdoc:*[not((local-name(.) = ("description", "param", "return")))]
    return
        for $annotation in $annotations
        return (

{
                let $annName := local-name($annotation)
                return
                    if ($annName = "error")
                        then "Errors:"
                        else concat(upper-case(substring($annName, 1, 1)), substring($annName, 2), ":")
            }
,

{$annotation/text()}

        )
};

declare function xhtml:return($comment) {
    let $return := $comment/xqdoc:return
    return
        if (exists($return)) then (

Returns:
,

{$return/text()}

        ) else ()
};

declare function xhtml:description($comment)
{

{
        if($comment/xqdoc:description) then
            {replace($comment/xqdoc:description/text(), "\n", "<br />")}
        else
            "No description available."
     }

};

declare function xhtml:module-description($module)
{
    (
Module Description
,
     xhtml:description($module/xqdoc:comment),
     xhtml:annotations($module/xqdoc:comment))
};

declare function xhtml:module-variables($variables)
{
    (
Variables
,
    if(count($variables/xqdoc:variable)) then
        for $variable in $variables/xqdoc:variable
        return (
{$variable/xqdoc:uri}
,
                xhtml:description($variable/xqdoc:comment),
                xhtml:annotations($variable/xqdoc:comment))
    else

No variables declared.

    )
};

declare function xhtml:module-function-summary($functions)
{

Function Summary
,
    if(count($functions/xqdoc:function)) then

{
            for $function in $functions/xqdoc:function
            let $name := $function/xqdoc:name/text(),
                $signature := $function/xqdoc:signature/text(),
                $param-number := count(tokenize($signature, "\$")) - 1
            order by $name, $param-number
            return
                let $type := normalize-space(substring-after(substring-before($signature, "function"), "declare")),
                    $isExternal := ends-with($signature, "external"),
                    $paramsAndReturn :=
                        if ($isExternal)
                            then normalize-space(substring-before(substring-after($signature, $name), "external"))
                            else normalize-space(substring-after($signature, $name))
                return

                        {$type}

{$name}{$paramsAndReturn}

        }

    else

No functions declared.

};

declare function xhtml:module-functions($functions) {
    if(count($functions/xqdoc:function)) then (

Functions
,
        for $function in $functions/xqdoc:function
        let $name := $function/xqdoc:name/text(),
            $signature := $function/xqdoc:signature/text(),
            $param-number := count(tokenize($signature, "\$")) - 1,
            $comment := $function/xqdoc:comment
        return (

{$name}
,

{xhtml:split-function-signature($signature)}
,
            xhtml:description($comment),
            xhtml:parameters($comment),
            xhtml:return($comment),
            xhtml:annotations($comment),

)
         )
    else ()
};

declare function xhtml:split-function-signature($signature as xs:string) {
    let $line1 := substring-before($signature, "(")
    let $rest := substring-after($signature, "(")
    let $params :=
        (: if the function has parameter :)
        if (matches($rest, "\$")) then
            let $tmp := substring-before($rest, ") as ")
            return
                (: if we don't have a return type specified :)
                if ($tmp eq "") then
                    (: en external function declaration :)
                    if (ends-with($rest, ") external")) then
                        substring-before($rest, ") external")
                    (: no external function :)
                    else
                        $rest
                (: the return type is specified :)
                else
                    $tmp
        (: no parameters :)
        else
            ""
    let $after := substring-after($signature, concat($params, ")"))
    return (
        concat($line1, " ("),

,
        for $param at $pos in tokenize($params, "\$")
        where $pos > 1
        return (
            concat("            $", normalize-space($param)),

        ),
        concat(")", $after)
    )
};


adjust test for orderBy clause to full collection path

xquery version "3.0";

module namespace flwor="http://exist-db.org/xquery/test/flwor";

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

declare variable $flwor:COLLECTION_CONFIG :=
    <collection xmlns="http://exist-db.org/collection-config/1.0">
        <index xmlns:xs="http://www.w3.org/2001/XMLSchema">
            <fulltext default="none" attributes="false"/>
            <range>
                <create qname="place">
                    <field name="place-id" type="xs:string" match="@xml:id"/>
                    <field name="place-name" type="xs:string" match="placeName"/>
                </create>
            </range>
        </index>
    </collection>;

declare variable $flwor:DATA :=
    <listPlace>
         <place xml:id="warsaw">
             <placeName>Warsaw</placeName>
         </place>
         <place xml:id="berlin">
             <placeName>Berlin</placeName>
         </place>
    </listPlace>;

declare variable $flwor:COLLECTION_NAME := "flwortest";
declare variable $flwor:COLLECTION := "/db/" || $flwor:COLLECTION_NAME;

declare
    %test:setUp
function flwor:setup() {
    xmldb:create-collection("/db/system/config/db", $flwor:COLLECTION_NAME),
    xmldb:store("/db/system/config/db/" || $flwor:COLLECTION_NAME, "collection.xconf", $flwor:COLLECTION_CONFIG),
    xmldb:create-collection("/db", $flwor:COLLECTION_NAME),
    xmldb:store($flwor:COLLECTION, "test.xml", $flwor:DATA)
};

declare
    %test:tearDown
function flwor:cleanup() {
    xmldb:remove($flwor:COLLECTION),
    xmldb:remove("/db/system/config/db/" || $flwor:COLLECTION_NAME)
};

declare function flwor:test($name) {
    collection($flwor:COLLECTION)//place[placeName = $name]/string()
};

declare
    %test:assertEquals("Berlin", "Berlin")
function flwor:order-by-with-range() {
    for $i in 1 to 2
    order by $i
    return
        flwor:test("Berlin")
};

(: https://github.com/eXist-db/exist/issues/739#issuecomment-130997865 :)
declare
    %test:assertEquals(1, 2, 1, 2, 3, 1, 2, 3, 4)
function flwor:orderby-for-multi() {
    for $x in (3, 2, 4)
    order by $x
    for $y in (1 to $x)
    return $y
};

declare
    %test:assertEquals("a1", "a2", "b1", "b2")
function flwor:orderby-multi() {
  for $a in ("b", "a")
  order by $a
  for $b in (2, 1)
  order by $b
  return
    $a || $b
};

declare
    %test:assertEquals("a1", "a2", "b1", "b2")
function flwor:orderby-where-multi() {
    for $a in ("b", "a", "c")
    order by $a
    where $a = ("a", "b")
    for $b in (2, 1, 5, 6, 9)
    where $b < 4
    order by $b
    return
        $a || $b
};

declare
    %test:assertEquals(2, 4)
function flwor:where-multi() {
    for $a in 1 to 10
    where $a mod 2 = 0
    where $a < 5
    return
        $a
};

declare
    %test:assertEquals(1, 1)
function flwor:where-multi-groupby() {
    let $xml :=
        <t>
            <n class="a">1</n>
            <n class="b">2</n>
            <n class="a">1</n>
            <n class="a">3</n>
        </t>
    for $a in $xml/n
    where $a != 3
    group by $c := $a/@class
    where count($a) > 1
    return
        $a/string()
};

declare
    %test:args(0)
    %test:assertEquals("[]")
    %test:args(1)
    %test:assertEquals("[1]")
    %test:args(6)
    %test:assertEquals("[1]", "[2]", "[3]", "[4]", "[6]")
function flwor:allowing-empty($n as xs:integer) {
    for $x allowing empty in 1 to $n
    where not($x = 5)
    return concat("[", $x, "]")
};

xquery version "3.0";

module namespace flwor="http://exist-db.org/xquery/test/flwor";

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

declare variable $flwor:COLLECTION_CONFIG :=
    <collection xmlns="http://exist-db.org/collection-config/1.0">
        <index xmlns:xs="http://www.w3.org/2001/XMLSchema">
            <fulltext default="none" attributes="false"/>
            <range>
                <create qname="place">
                    <field name="place-id" type="xs:string" match="@xml:id"/>
                    <field name="place-name" type="xs:string" match="placeName"/>
                </create>
            </range>
        </index>
    </collection>;

declare variable $flwor:DATA :=
    <listPlace>
         <place xml:id="warsaw">
             <placeName>Warsaw</placeName>
         </place>
         <place xml:id="berlin">
             <placeName>Berlin</placeName>
         </place>
    </listPlace>;

declare variable $flwor:COLLECTION_NAME := "flwortest";
declare variable $flwor:COLLECTION := "/db/" || $flwor:COLLECTION_NAME;

declare
    %test:setUp
function flwor:setup() {
    xmldb:create-collection("/db/system/config/db", $flwor:COLLECTION_NAME),
    xmldb:store("/db/system/config/db/" || $flwor:COLLECTION_NAME, "collection.xconf", $flwor:COLLECTION_CONFIG),
    xmldb:create-collection("/db", $flwor:COLLECTION_NAME),
    xmldb:store($flwor:COLLECTION, "test.xml", $flwor:DATA)
};

declare
    %test:tearDown
function flwor:cleanup() {
    xmldb:remove($flwor:COLLECTION),
    xmldb:remove("/db/system/config/db/" || $flwor:COLLECTION_NAME)
};

declare function flwor:test($name) {
    collection($flwor:COLLECTION_NAME)//place[placeName = $name]/string()
};

declare
    %test:assertEquals("Berlin", "Berlin")
function flwor:order-by-with-range() {
    for $i in 1 to 2
    order by $i
    return
        flwor:test("Berlin")
};

(: https://github.com/eXist-db/exist/issues/739#issuecomment-130997865 :)
declare
    %test:assertEquals(1, 2, 1, 2, 3, 1, 2, 3, 4)
function flwor:orderby-for-multi() {
    for $x in (3, 2, 4)
    order by $x
    for $y in (1 to $x)
    return $y
};

declare
    %test:assertEquals("a1", "a2", "b1", "b2")
function flwor:orderby-multi() {
  for $a in ("b", "a")
  order by $a
  for $b in (2, 1)
  order by $b
  return
    $a || $b
};

declare
    %test:assertEquals("a1", "a2", "b1", "b2")
function flwor:orderby-where-multi() {
    for $a in ("b", "a", "c")
    order by $a
    where $a = ("a", "b")
    for $b in (2, 1, 5, 6, 9)
    where $b < 4
    order by $b
    return
        $a || $b
};

declare
    %test:assertEquals(2, 4)
function flwor:where-multi() {
    for $a in 1 to 10
    where $a mod 2 = 0
    where $a < 5
    return
        $a
};

declare
    %test:assertEquals(1, 1)
function flwor:where-multi-groupby() {
    let $xml :=
        <t>
            <n class="a">1</n>
            <n class="b">2</n>
            <n class="a">1</n>
            <n class="a">3</n>
        </t>
    for $a in $xml/n
    where $a != 3
    group by $c := $a/@class
    where count($a) > 1
    return
        $a/string()
};

declare
    %test:args(0)
    %test:assertEquals("[]")
    %test:args(1)
    %test:assertEquals("[1]")
    %test:args(6)
    %test:assertEquals("[1]", "[2]", "[3]", "[4]", "[6]")
function flwor:allowing-empty($n as xs:integer) {
    for $x allowing empty in 1 to $n
    where not($x = 5)
    return concat("[", $x, "]")
};


[bugfix] changed mime-type text/xml to application/xml ; all tests pass now

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

xquery version "1.0";

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

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

declare variable $doc external;

declare function t:setup-action($action) {
    typeswitch ($action)
        case element(create-collection) return
            xdb:create-collection($action/@parent, $action/@name)
        case element(store) return
			t:store($action)
        case element(remove-collection) return
            xdb:remove($action/@collection)
        default return
            ()
};

declare function t:store($action as element(store)) {
    let $type := if ($action/@type) then $action/@type/string() else "application/xml"
    let $data :=
		if ($action/*) then
			$action/*[1]
		else
			$action/string()
	return
        xdb:store($action/@collection, $action/@name, $data, $type)
};

declare function t:setup($setup as element(setup)) {
    for $action in $setup/*
    return
        t:setup-action($action)
};

declare function t:tearDown($tearDown as element(tearDown)?) {
    for $action in $tearDown/*
    return
        t:setup-action($action)
};

declare function t:run-test($test as element(test), $count as xs:integer) {

	let $context :=
	    string-join(
        	for $var in $test/../variable
        	return
        	    concat("declare variable $", $var/@name, " := ", util:serialize($var/*, ()), ";"),
            ""
        )
    let $output :=
		util:catch("*",
			util:eval(concat($context, $test/code/string())),
			<error>Compilation error: {$util:exception-message}</error>
		)
    let $expected :=
        if ($test/@output eq 'text') then
            data($test/expected)
        else $test/expected/node()
    let $OK :=
        if ($test/xpath) then
            exists(t:xpath($output, $test/xpath))
        else if ($test/@output eq 'text') then
            normalize-space(string-join(for $x in $output return string($x),' ')) eq normalize-space($expected)
        else
            deep-equal($output, $expected)
    return
        <test n="{$count}" pass="{$OK}">
        {
            if (not($OK)) then
                ($test/task, $test/expected, <result>{$output}</result>)
            else ()
        }
        </test>
};

declare function t:xpath($output as item()*, $xpath as element()) {
    for $prefix in in-scope-prefixes($xpath)
    let $nsuri := namespace-uri-for-prefix($prefix, $xpath)
    return
        if ($prefix != 'xml') then
        util:declare-namespace($prefix, $nsuri)
        else (),
    util:eval(concat("$output", $xpath))
};

declare function t:run-testSet($set as element(TestSet)) {
    let $null := t:setup($set/setup)
    let $result :=
        <TestSet>
        {
            for $test at $p in $set/test
            return
                t:run-test($test, $p)
        }
        </TestSet>
    let $null := t:tearDown($set/tearDown)
    return $result
};

t:run-testSet(doc($doc)/TestSet)

xquery version "1.0";

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

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

declare variable $doc external;

declare function t:setup-action($action) {
    typeswitch ($action)
        case element(create-collection) return
            xdb:create-collection($action/@parent, $action/@name)
        case element(store) return
			t:store($action)
        case element(remove-collection) return
            xdb:remove($action/@collection)
        default return
            ()
};

declare function t:store($action as element(store)) {
    let $type := if ($action/@type) then $action/@type/string() else "text/xml"
    let $data :=
		if ($action/*) then
			$action/*[1]
		else
			$action/string()
	return
        xdb:store($action/@collection, $action/@name, $data, $type)
};

declare function t:setup($setup as element(setup)) {
    for $action in $setup/*
    return
        t:setup-action($action)
};

declare function t:tearDown($tearDown as element(tearDown)?) {
    for $action in $tearDown/*
    return
        t:setup-action($action)
};

declare function t:run-test($test as element(test), $count as xs:integer) {

	let $context :=
	    string-join(
        	for $var in $test/../variable
        	return
        	    concat("declare variable $", $var/@name, " := ", util:serialize($var/*, ()), ";"),
            ""
        )
    let $output :=
		util:catch("*",
			util:eval(concat($context, $test/code/string())),
			<error>Compilation error: {$util:exception-message}</error>
		)
    let $expected :=
        if ($test/@output eq 'text') then
            data($test/expected)
        else $test/expected/node()
    let $OK :=
        if ($test/xpath) then
            exists(t:xpath($output, $test/xpath))
        else if ($test/@output eq 'text') then
            normalize-space(string-join(for $x in $output return string($x),' ')) eq normalize-space($expected)
        else
            deep-equal($output, $expected)
    return
        <test n="{$count}" pass="{$OK}">
        {
            if (not($OK)) then
                ($test/task, $test/expected, <result>{$output}</result>)
            else ()
        }
        </test>
};

declare function t:xpath($output as item()*, $xpath as element()) {
    for $prefix in in-scope-prefixes($xpath)
    let $nsuri := namespace-uri-for-prefix($prefix, $xpath)
    return
        if ($prefix != 'xml') then
        util:declare-namespace($prefix, $nsuri)
        else (),
    util:eval(concat("$output", $xpath))
};

declare function t:run-testSet($set as element(TestSet)) {
    let $null := t:setup($set/setup)
    let $result :=
        <TestSet>
        {
            for $test at $p in $set/test
            return
                t:run-test($test, $p)
        }
        </TestSet>
    let $null := t:tearDown($set/tearDown)
    return $result
};

t:run-testSet(doc($doc)/TestSet)


Updated key file per issue #76

Updated key file per issue #76

xquery version "1.0-ml";

(: This module was generated by MarkLogic Entity Services.                          :)
(: The source entity type document was et-required-0.0.1                            :)
(:                                                                                :)
(: To use this module, examine how you wish to extract data from sources,           :)
(: and modify the various extract-instance-{X} functions to                         :)
(: create the instances you wish.                                                   :)
(:                                                                                :)
(: You may wish to/need to alter                                                    :)
(: 1.  values.  For example, creating duration values from decimal months.          :)
(: 2.  references.  This conversion module assumes you want to denormalize          :)
(:     instances when storing them in documents.  You may choose to remove          :)
(:     code that denormalizes, and just include reference values in your instances  :)
(:     instead.                                                                     :)
(: 3.  Source XPath expressions.  The data coming into the extract-instance-{X}     :)
(:     functions will probably not be exactly what this module predicts.            :)
(:                                                                                :)
(: After modifying this file, put it in your project for deployment to the modules  :)
(: database of your application, and check it into your source control system.      :)
(:                                                                                :)
(: Modification History:                                                            :)
(: Generated at timestamp: 2016-10-01T21:15:17.691943-07:00                         :)
(:   Persisted by AUTHOR                                                            :)
(:   Date: DATE                                                                     :)
module namespace et-required
    = "http://baloo/et-required-0.0.1";

import module namespace es = "http://marklogic.com/entity-services"
    at "/MarkLogic/entity-services/entity-services.xqy";

declare option xdmp:mapping "false";

(:  extract-instance-{entity-type} functions                                        :)
(:                                                                                :)
(:  These functions take together take a source document and create a nested        :)
(:  map structure from it.                                                          :)
(:  The resulting map is used by instance-to-canonical-xml to create documents      :)
(:  in the database.                                                                :)
(:                                                                                :)
(:  It is expected that an implementer will edit at least XPath expressions in      :)
(:  the extraction functions.  It is less likely that you will want to edit         :)
(:  the instance-to-canonical-xml or envelope functions.                            :)

(:~
 : Creates a map:map instance from some source document.
 : @param $source-node  A document or node that contains
 :   data for populating a ETOne
 : @return A map:map instance with extracted data and
 :   metadata about the instance.
 :)
declare function et-required:extract-instance-ETOne(
    $source as node()?
) as map:map
{
    let $source-node :=
        if ( ($source instance of document-node())
            or (exists($source/ETOne)))
        then $source/node()
        else $source
    let $instance := json:object()
(: Add the original source document as an attachment.                               :)
        =>map:with('$attachments',
            typeswitch($source-node)
            case object-node() return xdmp:quote($source)
            case array-node() return xdmp:quote($source)
            default return $source)
        =>map:with('$type', 'ETOne')
    return
(: if this $source-node is a reference to another instance, then extract its key    :)
    if (empty($source-node/*))
    then $instance=>map:with('$ref', $source-node/text())
(: Otherwise, this source node contains instance data, so populate it.              :)
    else
        $instance
(: The following line identifies the type of this instance.  Do not change it.      :)
(: because this implementation uses an XML envelope.                                :)
(:                                                                                :)
(: The following code populates the properties of the                               :)
(: 'ETOne' entity type                                                              :)
(: Ensure that all of the property paths are correct for your source data.          :)
(: The general pattern is                                                           :)
(: =>map:with('keyName', casting-function($source-node/path/to/data))               :)
(: but you may also wish to convert values                                          :)
(: =>map:with('dateKeyName',                                                        :)
(:       xdmp:parse-dateTime("[Y0001]-[M01]-[D01]T[h01]:[m01]:[s01].[f1][Z]",       :)
(:       $source-node/path/to/data/in/the/source))                                  :)
(: You can also implement lookup functions,                                         :)
(: =>map:with('lookupKey',                                                          :)
(:       cts:search( collection('customers'),                                       :)
(:           string($source-node/path/to/lookup/key))/id                            :)
(: or populate the instance with constants.                                         :)
(: =>map:with('constantValue', 10)                                                  :)
(: The output of this function should structurally match the output of              :)
(: es:model-get-test-instances($model)                                              :)
(:                                                                                :)
 =>   map:with('a',                      xs:integer($source-node/a))
 =>   map:with('b',                      xs:string($source-node/b))
 =>es:optional('c',                      xs:date($source-node/c))

};

(:~
 : Turns an entity instance into an XML structure.
 : This out-of-the box implementation traverses a map structure
 : and turns it deterministically into an XML tree.
 : Using this function as-is should be sufficient for most use
 : cases, and will play well with other generated artifacts.
 : @param $entity-instance A map:map instance returned from one of the extract-instance
 :    functions.
 : @return An XML element that encodes the instance.
 :)
declare function et-required:instance-to-canonical-xml(
    $entity-instance as map:map
) as element()
{
    (: Construct an element that is named the same as the Entity Type :)
    element { map:get($entity-instance, "$type") }  {
        if ( map:contains($entity-instance, "$ref") )
        then map:get($entity-instance, "$ref")
        else
            for $key in map:keys($entity-instance)
            let $instance-property := map:get($entity-instance, $key)
            where ($key castable as xs:NCName and $key ne "$type")
            return
                typeswitch ($instance-property)
                (: This branch handles embedded objects.  You can choose to prune
                   an entity's representation of extend it with lookups here. :)
                case json:object+
                    return
                        for $prop in $instance-property
                        return element { $key } { et-required:instance-to-canonical-xml($prop) }
                (: An array can also treated as multiple elements :)
                case json:array
                    return
                        for $val in json:array-values($instance-property)
                        return
                            if ($val instance of json:object)
                            then element { $key } { et-required:instance-to-canonical-xml($val) }
                            else element { $key } { $val }
                (: A sequence of values should be simply treated as multiple elements :)
                case item()+
                    return
                        for $val in $instance-property
                        return element { $key } { $val }
                default return element { $key } { $instance-property }
    }
};

(:
 : Wraps a canonical instance (returned by instance-to-canonical-xml())
 : within an envelope patterned document, along with the source
 : document, which is stored in an attachments section.
 : @param $entity-instance an instance, as returned by an extract-instance
 : function
 : @return A document which wraps both the canonical instance and source docs.
 :)
declare function et-required:instance-to-envelope(
    $entity-instance as map:map
) as document-node()
{
    document {
        element es:envelope {
            element es:instance {
                element es:info {
                    element es:title { map:get($entity-instance,'$type') },
                    element es:version { "0.0.1" }
                },
                et-required:instance-to-canonical-xml($entity-instance)
            },
            element es:attachments {
                map:get($entity-instance, "$attachments")
            }
        }
    }
};

xquery version "1.0-ml";

(: This module was generated by MarkLogic Entity Services.                          :)
(: The source entity type document was et-required-0.0.1                            :)
(:                                                                                :)
(: To use this module, examine how you wish to extract data from sources,           :)
(: and modify the various extract-instance-{X} functions to                         :)
(: create the instances you wish.                                                   :)
(:                                                                                :)
(: You may wish to/need to alter                                                    :)
(: 1.  values.  For example, creating duration values from decimal months.          :)
(: 2.  references.  This conversion module assumes you want to denormalize          :)
(:     instances when storing them in documents.  You may choose to remove          :)
(:     code that denormalizes, and just include reference values in your instances  :)
(:     instead.                                                                     :)
(: 3.  Source XPath expressions.  The data coming into the extract-instance-{X}     :)
(:     functions will probably not be exactly what this module predicts.            :)
(:                                                                                :)
(: After modifying this file, put it in your project for deployment to the modules  :)
(: database of your application, and check it into your source control system.      :)
(:                                                                                :)
(: Modification History:                                                            :)
(: Generated at timestamp: 2016-08-08T12:04:27.212622-07:00                         :)
(:   Persisted by AUTHOR                                                            :)
(:   Date: DATE                                                                     :)
module namespace et-required
    = "http://baloo/et-required-0.0.1";

import module namespace es = "http://marklogic.com/entity-services"
    at "/MarkLogic/entity-services/entity-services.xqy";

(:  extract-instance-{entity-type} functions                                        :)
(:                                                                                :)
(:  These functions take together take a source document and create a nested        :)
(:  map structure from it.                                                          :)
(:  The resulting map is used by instance-to-canonical-xml to create documents      :)
(:  in the database.                                                                :)
(:                                                                                :)
(:  It is expected that an implementer will edit at least XPath expressions in      :)
(:  the extraction functions.  It is less likely that you will want to edit         :)
(:  the instance-to-canonical-xml or envelope functions.                            :)

(:~
 : Creates a map:map instance from some source document.
 : @param $source-node  A document or node that contains
 :   data for populating a ETOne
 : @return A map:map instance with extracted data and
 :   metadata about the instance.
 :)
declare function et-required:extract-instance-ETOne(
    $source-node as node()
) as map:map
{
(: if this $source-node is a reference to another instance, then short circuit.     :)
    if (empty($source-node/element()/*))
    then json:object()
        =>map:with('$type', 'ETOne')
        =>map:with('$ref', $source-node/ETOne/text())
        =>map:with('$attachments', $source-node)
(: otherwise populate this instance :)
    else json:object()
(: The following line identifies the type of this instance.  Do not change it.      :)
        =>map:with('$type', 'ETOne')
(: The following line adds the original source document as an attachment.           :)
        =>map:with('$attachments', $source-node)
(: If the source document is JSON, remove the previous line and replace it with     :)
(: =>map:with('$attachments', xdmp:quote($source-node))                             :)
(: because this implementation uses an XML envelope.                                :)
(:                                                                                :)
(: The following code populates the properties of the                               :)
(: 'ETOne' entity type                                                              :)
(: Ensure that all of the property paths are correct for your source data.          :)
(: The general pattern is                                                           :)
(: =>map:with('keyName', casting-function($source-node/path/to/data))               :)
(: but you may also wish to convert values                                          :)
(: =>map:with('dateKeyName',                                                        :)
(:       xdmp:parse-dateTime("[Y0001]-[M01]-[D01]T[h01]:[m01]:[s01].[f1][Z]",       :)
(:       $source-node/path/to/data/in/the/source))                                  :)
(: You can also implement lookup functions,                                         :)
(: =>map:with('lookupKey',                                                          :)
(:       cts:search( collection('customers'),                                       :)
(:           string($source-node/path/to/lookup/key))/id                            :)
(: or populate the instance with constants.                                         :)
(: =>map:with('constantValue', 10)                                                  :)
(: The output of this function should structurally match the output of              :)
(: es:model-get-test-instances($model)                                              :)
(:                                                                                :)
 =>   map:with('a',                      xs:integer($source-node/ETOne/a))
 =>   map:with('b',                      xs:string($source-node/ETOne/b))
 =>es:optional('c',                      xs:date($source-node/ETOne/c))

};

(:~
 : This function includes an array if there are items to put in it.
 : If there are no such items, then it returns an empty sequence.
 : TODO EA-4? move to es: module
 :)
declare function et-required:extract-array(
    $path-to-property as item()*,
    $fn as function(*)
) as json:array?
{
    if (empty($path-to-property))
    then ()
    else json:to-array($path-to-property ! $fn(.))
};

(:~
 : Turns an entity instance into an XML structure.
 : This out-of-the box implementation traverses a map structure
 : and turns it deterministically into an XML tree.
 : Using this function as-is should be sufficient for most use
 : cases, and will play well with other generated artifacts.
 : @param $entity-instance A map:map instance returned from one of the extract-instance
 :    functions.
 : @return An XML element that encodes the instance.
 :)
declare function et-required:instance-to-canonical-xml(
    $entity-instance as map:map
) as element()
{
    (: Construct an element that is named the same as the Entity Type :)
    element { map:get($entity-instance, "$type") }  {
        if ( map:contains($entity-instance, "$ref") )
        then map:get($entity-instance, "$ref")
        else
            for $key in map:keys($entity-instance)
            let $instance-property := map:get($entity-instance, $key)
            where ($key castable as xs:NCName and $key ne "$type")
            return
                typeswitch ($instance-property)
                (: This branch handles embedded objects.  You can choose to prune
                   an entity's representation of extend it with lookups here. :)
                case json:object+
                    return
                        for $prop in $instance-property
                        return element { $key } { et-required:instance-to-canonical-xml($prop) }
                (: An array can also treated as multiple elements :)
                case json:array
                    return
                        for $val in json:array-values($instance-property)
                        return
                            if ($val instance of json:object)
                            then element { $key } { et-required:instance-to-canonical-xml($val) }
                            else element { $key } { $val }
                (: A sequence of values should be simply treated as multiple elements :)
                case item()+
                    return
                        for $val in $instance-property
                        return element { $key } { $val }
                default return element { $key } { $instance-property }
    }
};

(:
 : Wraps a canonical instance (returned by instance-to-canonical-xml())
 : within an envelope patterned document, along with the source
 : document, which is stored in an attachments section.
 : @param $entity-instance an instance, as returned by an extract-instance
 : function
 : @return A document which wraps both the canonical instance and source docs.
 :)
declare function et-required:instance-to-envelope(
    $entity-instance as map:map
) as document-node()
{
    document {
        element es:envelope {
            element es:instance {
                element es:info {
                    element es:title { map:get($entity-instance,'$type') },
                    element es:version { "0.0.1" }
                },
                et-required:instance-to-canonical-xml($entity-instance)
            },
            element es:attachments {
                map:get($entity-instance, "$attachments")
            }
        }
    }
};