xquery version "3.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.
:)
import module namespace get     = "http://art-decor.org/ns/art-decor-settings" at "art-decor-settings.xqm";
import module namespace art     = "http://art-decor.org/ns/art" at "art-decor.xqm";
import module namespace comp    = "http://art-decor.org/ns/art-decor-compile" at "../api/api-decor-compile.xqm";

declare namespace hl7           = "urn:hl7-org:v3";
declare namespace validation    = "http://exist-db.org/xquery/validation";
declare namespace transform     = "http://exist-db.org/xquery/transform";
declare namespace svrl          = "http://purl.oclc.org/dsdl/svrl";
declare namespace xsl           = "http://www.w3.org/1999/XSL/Transform";
declare namespace sch           = "http://purl.oclc.org/dsdl/schematron";

declare %private function local:svrl2report($resulttransform)  as element(report) {
    <report>
        <status rulescnt="{count($resulttransform//svrl:failed-assert | $resulttransform/svrl:successful-report)}">
        {
            if ($resulttransform/svrl:failed-assert[empty(@role)] | $resulttransform/svrl:successful-report[empty(@role)] |
                $resulttransform/svrl:failed-assert[@role = 'error'] | $resulttransform/svrl:successful-report[@role = 'error'])
            then 'invalid'
            else
            if ($resulttransform/svrl:failed-assert[@role = 'warning'] | $resulttransform/svrl:successful-report[@role = 'warning'] |
                $resulttransform/svrl:failed-assert[@role = 'warn'] | $resulttransform/svrl:successful-report[@role = 'warn'])
            then 'warning'
            else
            if ($resulttransform/svrl:failed-assert[@role = 'info'] | $resulttransform/svrl:successful-report[@role = 'info'])
            then 'info'
            else 'valid'
        }
        </status>
        <message>
        {
            (:
            <svrl:failed-assert location="/Q{}decor[1]/Q{}datasets[1]/Q{}dataset[1]/Q{}concept[1]/Q{}concept[3]" role="info" test="not($isInTransactionWithConnectedTemplate and $allTemplates) or $isInTemplate">
                <svrl:text>INFO: concept (type='group') is used in at least one transaction connected to a template, but does not have a templateAssociation. | Location &lt;concept id="2.16.840.1.113883.3.1937.99.62.3.2.18" effectiveDate="2011-01-28T00:00:00" name="Gegevens gewichtstoename"/&gt;</svrl:text>
            </svrl:failed-assert>
            :)
        
            for $node in $resulttransform/svrl:failed-assert | $resulttransform/svrl:successful-report
            return
                element {local-name($node)} {
                    $node/@*,
                    for $subnode in $node/*
                    return
                        element {local-name($subnode)} {$subnode/@*, $subnode/node()}
                }
        }
        </message>
    </report>
};

let $parameters         := if (request:exists()) then request:get-data()/decor-parameters else (
<decor-parameters xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:noNamespaceSchemaLocation="https://assets.art-decor.org/ADAR/rv/decor-parameters.xsd" initialdefault="false" project="demo1-">
    <switchCreateSchematron1/>
    <switchCreateSchematronWithWrapperIncludes0/>
    <switchCreateSchematronWithWarningsOnOpen0/>
    <switchCreateSchematronClosed0/>
    <switchCreateSchematronWithExplicitIncludes0/>
    <switchCreateDocHTML1/>
    <switchCreateDocSVG1/>
    <switchCreateDocDocbook0/>
    <switchCreateDocPDF0/>
    <useLocalAssets1/>
    <useLocalLogos1/>
    <useCustomLogo0/>
    <useLatestDecorVersion1/>
    <inDevelopment0/>
    <defaultLanguage>en-US</defaultLanguage>
    <switchCreateDatatypeChecks1/>
    <createDefaultInstancesForRepresentingTemplates1/>
    <artdecordeeplinkprefix>https://decor.nictiz.nl/art-decor/</artdecordeeplinkprefix>
    <bindingBehavior valueSets="freeze"/>
    <switchCreateTreeTableHtml1/>
    <filters filter="on" filterId="1">
        <filters id="1" label="TestLabel" created="2020-05-06T08:28:30" modified="2020-05-06T08:28:30">
            <transaction ref="2.16.840.1.113883.3.1937.99.62.3.4.1" flexibility="2012-09-05T16:59:35" statusCode="draft" name="Measurement"/>
        </filters>
    </filters>
    <documentation>
        <!-- ... -->
    </documentation>
    <transactions>
        <transaction id="2.16.840.1.113883.3.1937.99.62.3.4.1" effectiveDate="2012-09-05T16:59:35" statusCode="draft" type="group" filtered="true">
            <name language="en-US">Measurement</name>
            <name language="nl-NL">Meting</name>
            <desc language="en-US">A patient measures his or her own weight and length periodically and submits the results to a registry.</desc>
            <desc language="nl-NL">Een patiënt voert metingen uit en verzend deze periodiek naar een register.</desc>
        </transaction>
        <transaction id="2.16.840.1.113883.3.1937.99.62.3.4.4" effectiveDate="2012-09-05T16:59:35" statusCode="draft" type="group" filtered="false">
            <name language="en-US">Measurement with BSN</name>
            <name language="nl-NL">Meting op BSN</name>
            <desc language="en-US">A patient measures his or her own weight and length periodically and submits the results to a registry.</desc>
            <desc language="nl-NL">Een patiënt voert metingen uit en verzend deze periodiek naar een register.</desc>
        </transaction>
    </transactions>
</decor-parameters>
)
let $language           := if (request:exists()) then request:get-parameter('language', '*') else ()
let $doCompile          := if (request:exists()) then not(request:get-parameter('compile','true')='false') else true()

let $projectPrefix      := $parameters/@project[string-length() gt 0]
let $decor              := if ($projectPrefix=('*','')) then () else (art:getDecorByPrefix($projectPrefix))
let $language           := if ($language) then $language else $decor/project/@defaultLanguage
let $filters            := if ($decor and $doCompile) then comp:getFinalCompilationFilters($decor, comp:getCompilationFilters($decor, $parameters/filters, ())) else ()

(: check if a compiled result was saved earlier, or create it :)
let $compiledDecor      := 
    if ($decor) then 
        if ($projectPrefix = 'peri20-' or not($doCompile)) then ($decor) else comp:getCompiledResult($decor, current-dateTime(), $language, $filters, false(), false(), false()) 
    else ()

return
    if ($compiledDecor[descendant-or-self::decor]) then (
        let $compiledDecor          := $compiledDecor/descendant-or-self::decor[1]
        let $strDecorDevelopment    := get:strProjectDevelopment($projectPrefix)
        
        let $decorSchFile           := concat($get:strDecorCore, '/DECOR.sch')
        let $decorSch               := if (doc-available($decorSchFile)) then doc($decorSchFile) else ()
        let $projectChecks          := collection($strDecorDevelopment)//@optionalChecks[not(. = '')][1]
        let $optionalCheckFile      := concat($get:strDecorCore, '/DECOR-optional-checks.sch')
        let $optionalChecks         := if (doc-available($optionalCheckFile)) then doc($optionalCheckFile) else ()
        let $projectSchFile         := concat($strDecorDevelopment, $projectPrefix, 'checks.sch')
        let $projectSch             := if (doc-available($projectSchFile)) then doc($projectSchFile) else ()
        let $checkrpt               := concat($projectPrefix, 'decorcheck-report.xml')
        
        (: Projectschematron are: 
        - checks in DECOR-optional-checks.sch which are turned on in project/@optionalChecks (for reusable checks which can be useful to multiple projects)
        - a project-specific file [prefix]-checks.sch in decor/checks (for checks which are specific to just one project - schematron must be uploaded by eXist admin)
        :)
        let $projectSchematron      := 
            if ($projectChecks and $optionalChecks) 
            then
                <sch:schema queryBinding="xslt2" xmlns:sch="http://purl.oclc.org/dsdl/schematron">
                    <sch:ns uri="http://purl.oclc.org/dsdl/schematron" prefix="sch"/>
                {
                    for $check in tokenize($projectChecks, '\s+')
                    return $optionalChecks//sch:pattern[@id=$check]
                }
                {
                    for $pattern in $projectSch//sch:pattern
                    return $pattern
                }
                </sch:schema>
            else ()
        
        let $lastChecked            := current-dateTime()
        let $lastModified           := xmldb:last-modified(util:collection-name($decor), util:document-name($decor))
        let $checked                := true()
        
        let $decorschresult         := transform:transform($compiledDecor, art:get-iso-schematron-svrl($decorSch), ())
        let $projectschresult       := 
            if ($projectPrefix = 'peri20-') then () else 
            if ($projectSchematron[sch:pattern]) then transform:transform($compiledDecor, art:get-iso-schematron-svrl($projectSchematron), ()) else ()
        
        let $report                 := 
            <report lastChecked="{$lastChecked}" lastModified="{$lastModified}" checked="{$checked}">
            {
                attribute compiled {exists($compiledDecor/@versionDate)},
                if (comp:isCompilationFilterActive($filters)) then (
                    attribute filterid {($filters/@id)[1]},
                    attribute filterlabel {($filters/@label, $filters/@id)[1]} 
                )
                else ()
            }
                <schema>
                {
                    (: validate against DECOR schema :)
                    validation:jaxv-report($decor, $get:docDecorSchema)
                }
                </schema>
                <schematron>
                {
                    (: validate against DECOR schematron :)
                    if ($decorschresult) then local:svrl2report($decorschresult) else ()
                }
                </schematron>
            {
                if ($projectschresult) then <projectSchematron>{local:svrl2report($projectschresult)}</projectSchematron> else ()
            }
            {
                if ($projectPrefix = 'peri20-') then (
                    <warnings>
                        <warning text="Compiled checking and project schematron disabled for performance reasons for project {data($projectPrefix)} '{data($decor/project/name[1])}'">
                            <concept/>
                        </warning>
                    </warnings>
                ) else ()
            }
            </report>
        
        (: store the result in cache checks :)
        let $save   := 
            try { 
                let $coll := xmldb:create-collection($get:strDecorVersion, replace(substring-after($strDecorDevelopment, $get:strDecorVersion), '^/+', ''))
                return xmldb:store($strDecorDevelopment, $checkrpt, $report)
            }
            catch * {"NOTSAVED"}
        let $save   := if ($save="NOTSAVED") then $save else try { sm:chmod(xs:anyURI($save), 'rw-rw-r--') } catch * {"NOTCHMODED"}
        let $save   := if ($save="NOTSAVED" or $save="NOTCHMODED") then $save else try { sm:chgrp(xs:anyURI($save), 'decor') } catch * {"NOTCHOWNED"}
        
        return (
            if (response:exists()) then (response:set-header('Content-Type','text/xml; charset=utf-8')) else (),
            <report>
            {
                $report/@*
            }
            {
                switch ($save)
                case ("NOTSAVED") return <checkError>Insufficient access rights to store report, please contact admin</checkError>
                case ("NOTCHMODED") return ()(:<checkWarning>Insufficient access rights to assign properties to report</checkWarning>:)
                case ("NOTCHOWNED") return ()(:<checkWarning>Insufficient access rights to assign owner to report</checkWarning>:)
                default return ()
            }
            {
                $report/*
            }
            </report>
        )
    )
    else
    if ($decor) then (
        <report>
            <checkWarning>Compilation running since {$compiledDecor/string(@compileDate)}. Please wait for this compilation to end or try again later.</checkWarning>
        </report>
    )
    else
    if ($projectPrefix[. = '']) then (
        if (response:exists()) then (response:set-status-code(404), response:set-header('Content-Type','text/xml; charset=utf-8')) else (), 
        <error>Missing parameter 'prefix'</error>
    )
    else (
        if (response:exists()) then (response:set-status-code(404), response:set-header('Content-Type','text/xml; charset=utf-8')) else (), 
        <error>Parameter prefix={$projectPrefix} is not a DECOR project prefix</error>
    )