xquery version "1.0";
(:
    ART-DECOR® STANDARD COPYRIGHT AND LICENSE NOTE
    Copyright © ART-DECOR Expert Group and ART-DECOR Open Tools GmbH
    see https://docs.art-decor.org/copyright and https://docs.art-decor.org/licenses

    This file is part of the ART-DECOR® tools suite.
:)

module namespace artx           = "http://art-decor.org/ns/art/xpath";
import module namespace get     = "http://art-decor.org/ns/art-decor-settings" at "art-decor-settings.xqm";

declare namespace lab       = "urn:oid:2.16.840.1.113883.2.4.6.10.35.81";
declare namespace request   = "http://exist-db.org/xquery/request";
declare namespace response  = "http://exist-db.org/xquery/response";
declare namespace hl7       = "urn:hl7-org:v3";
declare namespace util      = "http://exist-db.org/xquery/util";
declare option exist:serialize "indent=no";
declare option exist:serialize "omit-xml-declaration=no";

declare %private function artx:report($error as xs:string) as element() {
    element error {$error}
};

declare function artx:getXpathFromTemplate($node as element()*, $decor as element()*, $xpath as xs:string, $overrides as element()?, $representingTemplate as node(), $templateTrail as element(template)*) as node()* {
    (:  input: some node, all templates and associated concepts, Xpath up to node
        output: if some template//element has @id, outputs all associated concepts with @ref, @effectiveDate, @elementId and xpath
    
        recursively walks through templates, resolving contains and includes and choices :)

    (: do elements and attributes :)
    let $xpath := 
        if ($node[self::template]) then 
            (artx:getContextPath($node,$xpath))
        else if ($node[self::element]) then 
            (concat($xpath, if ($xpath=('/','//')) then () else ('/'), $node/@name)) 
        else if ($node[self::attribute]) then 
            (concat($xpath, '/@', $node/@name)) 
        else 
            ($xpath) 
    
    let $actualIsMandatory :=
        if ($overrides/@isMandatory) then
            $overrides/@isMandatory
        else if ($node[self::element][@isMandatory]) then
            ($node/@isMandatory)
        else attribute isMandatory {'false'}

    (: for mandatory elements, use 'M' :)
    let $actualConformance :=
        if ($actualIsMandatory = 'true') then attribute conformance {'M'} 
        else if ($overrides/@conformance) then
            $overrides/@conformance
        else if ($node[self::element][@conformance]) then
            ($node/@conformance)
        else attribute conformance {'O'}
    
    (: if nothing specified, then max=* :) 
    let $actualMaximumMultiplicity :=
        if ($overrides/@maximumMultiplicity) then
            $overrides/@maximumMultiplicity
        else if ($node[self::element][@maximumMultiplicity]) then
            ($node/@maximumMultiplicity)
        else attribute maximumMultiplicity {'*'}
    
    (: mandatory elements have min=1, if nothing specified, then min=0 :) 
    let $actualMinimumMultiplicity :=
        if ($actualIsMandatory = 'true') then attribute minimumMultiplicity {'1'} 
        else if ($overrides/@minimumMultiplicity) then
            $overrides/@minimumMultiplicity
        else if ($node[self::element][@minimumMultiplicity]) then
            ($node/@minimumMultiplicity)
        else attribute minimumMultiplicity {'0'}
    
    (: add root to xpath for id :)
    let $xpath := 
        if ($node/attribute[@root] | $node/attribute[@name='root'][@value]) then (
            concat($xpath,"[",
                string-join(
                    for $attr in $node/attribute[@root] | $node/attribute[@name='root']
                    return
                        concat("@root='", if ($attr/@root) then ($attr/@root) else ($attr/@value),"'")
                ,' or ')
            ,"]")
        ) else ($xpath)

    (: add code/codesystem :)
    let $xpath := 
        if ($node/vocabulary[@code] | $node/vocabulary[@codeSystem]) then (
            concat($xpath,"[",
                string-join(
                    for $attr in $node/vocabulary[@code] | $node/vocabulary[@codeSystem]
                    return
                        if ($attr[@code][@codeSystem]) then (
                            concat("(@code='", $attr/@code ,"' and @codeSystem='", $attr/@codeSystem ,"')")
                        ) 
                        else if ($attr[@code]) then (
                            concat("@code='", $attr/@code,"'")
                        ) 
                        else (
                            concat("@codeSystem='", $attr/@codeSystem ,"'")
                        )
                ,' or ')
            ,"]")
        ) else ($xpath)
    
    (: HL7 datatype :)
    let $hl7Type := 
        if ($node[self::element][@datatype])
        then attribute hl7Type {$node/@datatype} else ()

    (:  for include and @contains, pass on multiplicities, conformance, mandatory
        for templates, pass on again to element(s) :)
    let $overrides := 
        if ($node[self::include] | $node[@contains]) then
            <overrides>{$node/@*}</overrides>
        else $overrides
    
    let $template   := ()
return
    if ($node[self::attribute][@id] | $node[self::element] | $node[self::choice] | $node[self::include] | $node[self::template])
    then 
    (: output the element :)
        element {name($node)} 
        {   (: with it's own attributes :)
            $node/@*, 
            (: xpath so far with HL7Type:)
            attribute xpath {$xpath}, $hl7Type,
            (: for elements, associated concepts :)
            if ($node[self::attribute][@id] | $node[self::element][@id]) 
            then (
                let $concepts       := $decor//concept[@elementId=$node/@id][@ref=$representingTemplate/concept/@ref][ancestor::templateAssociation[@templateId=$node/ancestor::template/@id][@effectiveDate=$node/ancestor::template/@effectiveDate]]
                (:element actualCardConf {$actualMinimumMultiplicity, $actualMaximumMultiplicity, $actualConformance, $actualIsMandatory},:)
                (: return a concept for every templateAssociation/concept which corresponds to this element/@id and occurs in representingTemplate being processed :)
                return
                    if ($concepts) then (
                        <associatedConcepts>{for $concept in  $concepts return <concept>{$concept/@ref, $concept/@effectiveDate}</concept>}</associatedConcepts>
                    ) else ()
            )
            else (),
            (: for includes, include template :)
            if ($node[self::include]) 
            then (
                let $template   := artx:getSingleTemplate($decor, $node/@ref, if ($node/@flexibility) then $node/@flexibility else 'dynamic')
                return 
                    if ($templateTrail[@id=$template/@id][@effectiveDate=$template/@effectiveDate]) then (
                        (:circular reference found. now what?:)
                        <include>{$node/@*}<warning>Circular reference detected</warning></include>
                    ) else (
                        <include>{$node/@*, artx:getXpathFromTemplate($template, $decor, $xpath, $overrides, $representingTemplate, ($templateTrail | $template))}</include>
                    )
            )
            else (),
            (: ditto for contains :)
            if ($node[self::element][@contains]) 
            then (
                let $template   := artx:getSingleTemplate($decor, $node/@contains, if ($node/@flexibility) then $node/@flexibility else 'dynamic')
                return 
                    if ($templateTrail[@id=$template/@id][@effectiveDate=$template/@effectiveDate]) then (
                        (:circular reference found. now what?:)
                        <warning>Circular reference detected</warning>
                    ) else (
                        artx:getXpathFromTemplate($template, $decor, $xpath, $overrides, $representingTemplate, ($templateTrail | $template))
                    )
            )
            else (),
            (: process the children :)
            for $el in $node/* 
            return artx:getXpathFromTemplate($el, $decor, $xpath, (), $representingTemplate, ($templateTrail | $template))
        }
    else ()
};

declare function artx:getXpaths($decor as element(), $representingTemplate as element()) as node() {
(:  input: $decor node, $representingTemplate id
    output: <xpaths> containing an <xpath> for each concept in transaction
:)  
    let $nl         := "&#10;"
    let $tab        := "&#9;"
    let $lang       := data($decor//project/@defaultLanguage)
    
    let $template   :=
        if ($representingTemplate[@ref]) then 
            artx:getSingleTemplate($decor, $representingTemplate/@ref, $representingTemplate/@flexibility)
        else ()
    let $xpaths     := 
        if (not($template)) then 
            artx:report(concat('Template not found: ', $representingTemplate/@ref,' ',$representingTemplate/@flexibility))
        else 
            element {name($template)} {
                $template/@*, 
                for $el in $template/* 
                return artx:getXpathFromTemplate($el, $decor, artx:getContextPath($template, ''), (), $representingTemplate, $template)
            }
    return 
    element {'transactionXpaths'} {
        (: copy atts from transaction :) 
        attribute ref {data($representingTemplate/../@id)},
        $representingTemplate/../@*[not(local-name()='id')],
        element {'templateWithXpaths'} {$xpaths}
    }
};

declare function artx:getContextPath($template as node(), $xpath as xs:string) as xs:string {
(:  input:  template, xpath up to that template
    output: context path for template
:)
    (: Look if there's a templateId node which matches template/@id :)
    let $templateIdNode     := 
        $template//element[@name='hl7:templateId'][attribute/@root=$template/@id][@minimumMultiplicity > 0] |
        $template//element[@name='hl7:templateId'][attribute[@name='root']/@value=$template/@id][@minimumMultiplicity > 0]
    let $predContent        := 
        if ($templateIdNode/attribute[@root] | $templateIdNode/attribute[@name='root']) then (
            for $attr in $templateIdNode/attribute[@root] | $templateIdNode/attribute[@name='root']
            return
                if ($attr/@root) then (concat("@root='", $attr/@root ,"'")) else (concat("@root='", $attr/@value ,"'"))
        ) else ('')
    return
    (:  situation 1: template has <context id="*"/>
        - template must have template id
        - it does not have a fixed containing element (i.e. template's content may reside in element with any name :)
    if ($template/context[1][@id='*']) then (
        let $pred := if (string-length($predContent[1])>0) then (concat("hl7:templateId[",string-join($predContent,' or '),"]")) else ('')
        return
            if ($xpath and $pred) then 
                (concat($xpath,'[',$pred,']')) 
            else if (not($xpath) and $pred) then
                (concat('*[',$pred,']')) 
            else 
                ($xpath)
    )
    (:  situation 2: template has <context id="**"/>
        - template must have template id
        - it does have a fixed containing element (i.e. template's content resides in element with a particular name :)
    else if ($template/context[1][@id='**']) then (
        let $initialelementName := $template/element[1]/@name
        let $pred := if (string-length($predContent[1])>0) then (concat($initialelementName,"[hl7:templateId[",string-join($predContent,' or '),"]]")) else ($initialelementName)
        return
            if ($xpath and $pred) then 
                (concat($xpath,'[',$pred,']')) 
            else if (not($xpath) and $pred) then 
                (concat('*[',$pred,']')) 
            else 
                ($xpath)
    )
    (:  situation 3: template has <context> without @id
        - if template has path in context (<context path='...'/>, use path 
        - template may have template id
        - if template has no path in context, make path from code and codeSystem  
    :)
    else
        (: if context/@path, use it without further ado :)
        if ($template/context[1]/@path)
        (: if <context path='/'/> do not output the '/', leading slash is already appended for each element :)
        then $template/context[1]/@path 
        else
        (: situation 4: ask AH to check this, since he may understand this :) 
        (
        let $predContent := 
            if ($template/element[@name='hl7:code'][@minimumMultiplicity='1'][exists(vocabulary/@codeSystem)]) then (
                for $attr in $template/element[@name='hl7:code']/vocabulary[exists(@codeSystem)]
                return
                    if ($attr/@code) then (concat("(@code='", $attr/@code ,"' and @codeSystem='", $attr/@codeSystem ,"')")) else (concat("@codeSystem='", $attr/@codeSystem ,"'"))
            ) else if ($template/element[1]/element[@name='hl7:code'][@minimumMultiplicity='1'][exists(vocabulary/@codeSystem)]) then (
                for $attr in $template/element[1]/element[@name='hl7:code']/vocabulary[exists(@codeSystem)]
                return
                    if ($attr/@code) then (concat("(@code='", $attr/@code ,"' and @codeSystem='", $attr/@codeSystem ,"')")) else (concat("@codeSystem='", $attr/@codeSystem ,"'"))
            ) else ('')
        let $pred := 
            if ($predContent[1]) then (
                if ($template/element[@name='hl7:code']) then (
                    concat("hl7:code[",string-join($predContent,' or '),"]")
                )
                else (
                    concat($template/element[1]/@name,"[hl7:code[",string-join($predContent,' or '),"]]")
                )
            ) else ('')
        let $ctxPath := $template/context[1]/@path
        let $outPath :=
            if (not($xpath)) then '*' else $xpath
        let $outPath :=
            if ($ctxPath) then concat($outPath, if (starts-with($ctxPath, '/')) then () else '/', $ctxPath) 
            else ($outPath)
        let $outPath :=
            if ($pred) then (concat($outPath,'[',$pred,']'))
            else $outPath
        return $outPath
    )
};

declare function artx:getSingleTemplate($decor as node()*, $nameOrId as xs:string, $flexibility as xs:string? ) as element(template)? {
    let $allTemplates   := $decor//template[@id=$nameOrId] | $decor//template[@name=$nameOrId]
    let $effectiveDate  := 
        if ($flexibility castable as xs:dateTime) then ($flexibility) else (
            max($allTemplates/xs:dateTime(@effectiveDate))
        )
    let $templates      := $allTemplates[@effectiveDate=$effectiveDate]
    return
        $templates[1]
};


(: Of all templates in one specific Decor file, return those with the highest effectiveDate :)
declare function artx:currentTemplates($decor as node()* ) as element()*{
    (: returns a sequence with the relevant templates :)
    let $templates := $decor//template
    return 
        for $name in distinct-values($templates/@name)
        return $templates[@name=$name][@effectiveDate=max($templates[@name=$name]/xs:dateTime(@effectiveDate))]
};

(: Of all templateAssociations in one specific Decor file, return those with the highest effectiveDate :)
declare function artx:currentTemplateAssociations($decor as node()* ) as element()*{
    (: returns a sequence with the relevant templateAssociations :)
    let $templateAssociations := $decor//templateAssociation
    return 
        for $templateId in distinct-values($templateAssociations/@templateId)
        return $templateAssociations[@templateId=$templateId][@effectiveDate=max($templateAssociations[@templateId=$templateId]/xs:dateTime(@effectiveDate))]
};