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

declare namespace request   = "http://exist-db.org/xquery/request";
declare namespace response  = "http://exist-db.org/xquery/response";
declare namespace xdb       = "http://exist-db.org/xquery/xmldb";
declare namespace util      = "http://exist-db.org/xquery/util";

declare option exist:serialize "method=xml omit-xml-declaration=no indent=yes";

let $data               := if (request:exists()) then request:get-data()/id else (
<id closed="true" explicitIncludes="true" dieOnRecursion="false" forceRecompile="true">
    <transaction ref="2.16.840.1.113883.3.1937.99.62.3.4.1" flexibility="2012-09-05T16:59:35" statusCode="draft" name="Measurement"/>
</id>
)
let $projectPrefix      := if (request:exists()) then request:get-parameter('prefix', ())[not(. = '')] else 'demo1-'
(: requests: list, compile, download, delete :)
let $request            := if (request:exists()) then request:get-parameter('request', 'list') else 'config'
let $specificref        := if (request:exists()) then request:get-parameter('ref', '') else ''

(: DEFAULT value is true() :)
let $doClosed           := not($data/@closed = 'false')
let $doExplicitIncludes := not($data/@explicitIncludes = 'false')
let $doDieOnRecursion   := $data/@dieOnRecursion = 'true'
let $forceRecompile     := not($data/@forceRecompile = 'false')
let $testFilters        := false()
let $runtimeOnly        := true()

let $decor              := if (empty($projectPrefix)) then () else art:getDecorByPrefix($projectPrefix)

let $now                := substring-before(xs:string(current-dateTime()), '.')
let $stamp              := util:uuid()
let $author             := $decor/project/author[@username = get:strCurrentUserName()]
let $author             := if (empty($author)) then get:strCurrentUserName() else $author
let $language           := $decor/project/@defaultLanguage
let $timeStamp          := 'development'

return
    if ($request = 'config') then (
        (: CONFIG :)
        <id closed="{$doClosed}" explicitIncludes="{$doExplicitIncludes}" dieOnRecursion="{$doDieOnRecursion}" forceRecompile="{$forceRecompile}"/>
    ) else
    if ((string-length($projectPrefix) > 0) and ($request = 'list')) then (
        (: LIST :)
        let $compiledF :=
            if (string-length($specificref) > 0)
            then
                $get:colDecorVersion//compiled[@for = $projectPrefix][@as = $specificref][ancestor::compilation]
            else
                $get:colDecorVersion//compiled[@for = $projectPrefix][ancestor::compilation]
        let $compiledFF :=
            for $c in $compiledF
            order by $c/@on descending
            return
                <compiled>{$c/@*, $c/dir}</compiled>
        
        return
            <results type="list" for="{$projectPrefix}" from="{$specificref}">
            {
                for $c at $count in $compiledFF
                return
                    <compiled>
                    {
                        $c/@* except $c/@status,
                        if ($count < 3) then $c/@status else attribute {'status'} {'retired'},
                        $c/*
                    }
                    </compiled>
            }
            {
                for $t in $decor//transaction[@label]
                return
                    <transaction>
                    {
                        $t/@*,
                        $t/representingTemplate/@ref,
                        $t/name,
                        $t/desc
                    }
                    </transaction>
            }
            </results>
    )
    else 
    if ($decor and $request = 'compile') then (
        (: CREATE :)
        (: will create version/develop collection if it does not exist :)
        let $openOrClosed           := if ($doClosed) then <switchCreateSchematronWithWarningsOnOpen1/> else <switchCreateSchematronWithWarningsOnOpen0/>
        let $includeExplicitOrAll   := if ($doExplicitIncludes) then <switchCreateSchematronWithExplicitIncludes1/> else <switchCreateSchematronWithExplicitIncludes0/>
        let $dieOrContinue          := if ($doDieOnRecursion) then 'die' else 'continue'
        
        let $decor-paramfile        := concat(util:collection-name($decor), '/decor-parameters.xml')
        let $decor-params           := if (doc-available($decor-paramfile)) then doc($decor-paramfile)/decor-parameters else ()
        let $decor-parameters       :=
            if (empty($decor-params)) then (
                <decor-parameters>
                    <switchCreateSchematron1/>
                    <switchCreateSchematronWithWrapperIncludes0/>
                    {$openOrClosed},
                    <switchCreateSchematronClosed0/>
                    {$includeExplicitOrAll},
                    <switchCreateDocHTML0/>
                    <switchCreateDocSVG0/>
                    <switchCreateDocDocbook0/>
                    <useLocalAssets1/>
                    <useLocalLogos1/>
                    <useCustomLogo0/>
                    <useLatestDecorVersion0/>
                    <hideColumns>45gh</hideColumns>
                    <inDevelopment1/>
                    <switchCreateDatatypeChecks1/>
                    <createDefaultInstancesForRepresentingTemplates0/>
                    <!--<artdecordeeplinkprefix></artdecordeeplinkprefix>-->
                    <!--<useCustomRetrieve1 hidecolumns=""/>-->
                    <logLevel>OFF</logLevel>
                </decor-parameters>
            )
            else (
                <decor-parameters>
                {
                    $decor-params/(* except (inDevelopment0 | 
                                             inDevelopment1 | 
                                             useLatestDecorVersion0 | 
                                             useLatestDecorVersion1 | 
                                             switchCreateSchematronWithWarningsOnOpen0 | 
                                             switchCreateSchematronWithWarningsOnOpen1 | 
                                             switchCreateSchematronWithExplicitIncludes0 | 
                                             switchCreateSchematronWithExplicitIncludes1)),
                    <inDevelopment1/>,
                    <useLatestDecorVersion0/>,
                    $openOrClosed,
                    $includeExplicitOrAll
                }
                </decor-parameters>
            )
        
        let $filterset              := 
            if ($data[transaction]) then 
                <filters filter="on" filterId="1"><filters id="1" label="Runtime">{$data/transaction}</filters></filters> 
            else ()
        let $filters                := 
            if (comp:isCompilationFilterActive($filterset)) then 
                comp:getFinalCompilationFilters($decor, comp:getCompilationFilters($decor, $filterset, ()))
            else ()
        
        let $input                  :=
            try {
                (: check if a compiled full result was saved earlier, or create it :)
                let $compiledDecor          := 
                    if ($decor) then comp:getCompiledResult($decor, current-dateTime(), $language, (), false(), false(), ()) else ()
                (: check if a compiled runtimeonly result was saved earlier, or create it :)
                let $compiledDecor          := 
                    if ($compiledDecor[descendant-or-self::decor]) then $compiledDecor else (
                        comp:getCompiledResult($decor, current-dateTime(), $language, $filters, $testFilters, $runtimeOnly, $forceRecompile)
                    )
                return
                    if ($compiledDecor[descendant-or-self::decor]) then $compiledDecor/descendant-or-self::decor[1] else (
                        error('comp:DecorCompilationRunning', concat('Compilation running since ', $compiledDecor/string(@compileDate), '. Please wait for this compilation to end or try again later.'))
                    )
            }
            catch * {
                <error>+++ Compile decor failed: {$err:code}: {$err:description}</error>
            }
        
        (: create collections if allowed, propagate the errors :)
        let $targetDir              :=
            try {
                let $ttt    := xmldb:create-collection($get:strDecorVersion, concat(substring($projectPrefix, 1, string-length($projectPrefix) - 1),'/development'))
                let $tt     := try { sm:chmod(xs:anyURI($ttt), 'rwxrwsr-x') } catch * {()}
                
                return $ttt
            } catch * {
                <error>+++ Create collection failed '{concat(substring($projectPrefix, 1, string-length($projectPrefix) - 1),'/development')}': {$err:code}: {$err:description}</error>
            }
        
        let $schDir                 := 
            if ($targetDir castable as xs:string) then 
            try {
                let $ttt    := xmldb:create-collection($targetDir, $stamp)
                let $tt     := try { sm:chmod(xs:anyURI($ttt), 'rwxrwsr-x') } catch * {()}
                
                return $ttt
            } catch * {
                <error>+++ Create collection failed '{$stamp}': {$err:code}: {$err:description}</error>
            }
            else ()
         let $inclDir               := 
            if ($schDir castable as xs:string)
            then 
              try {
                  let $ttt    := xmldb:create-collection($schDir, 'include')
                  let $tt     := try { sm:chmod(xs:anyURI($ttt), 'rwxrwsr-x') } catch * {()}
                
                  return $ttt
              } catch * {
                  <error>+++ Create collection failed 'include' in {$stamp}: {$err:code}: {$err:description}</error>
              }
            else ()
            
        let $xslt                   := concat('xmldb:exist://', $get:strDecorCore, '/DECOR-templatefragment2schematron.xsl')
        
        let $templ-serialization-options := 'method=xml media-type=text/xml omit-xml-declaration=yes indent=no'
        let $templ-xsltparams       :=
            <parameters>
                <param name="outputBaseUriPrefix" value="{concat('xmldb:exist://', $schDir, '/')}"/>
                <param name="scriptBaseUriPrefix" value="{concat('xmldb:exist://', $get:strDecorCore, '/')}"/>
                <param name="inDevelopmentString" value="true"/>
                <param name="onCircularReferences" value="{$dieOrContinue}"/>
                <param name="seeThisUrlLocation" value="live"/>
                <param name="createSchematronbasedOn" value="scenario"/>
                <param name="switchCreateSchematronWithWarningsOnOpenString" value="{$doClosed}"/>
                <param name="switchCreateSchematronWithExplicitIncludesString" value="{$doExplicitIncludes}"/>
                <param name="logLevel" value="OFF"/>
            </parameters>
        let $templ-xsltattributes   :=
            <attributes>
                <attr name="http://saxon.sf.net/feature/trace-external-functions" value="true"/>
            </attributes>
        let $transform              :=
            if ($inclDir castable as xs:string and $input instance of element(decor)) then 
            try {
                transform:transform($input, xs:anyURI($xslt), $templ-xsltparams, (), $templ-serialization-options)
            }
            catch * {
                <error>+++ Transformation to schematron failed: {$err:code}: {$err:description} {$err:module} [at line {$err:line-number}, ref: {$stamp}]</error>
            }
            else ()
        let $last-survivor-message  :=
            if (doc-available(concat($schDir, "/last-survivor-message.xml"))) then doc(concat($schDir, "/last-survivor-message.xml")) else <empty/>
            
        let $transform              := 
            if (count($transform) gt 0) then $transform else (
                <error>+++ Transformation to schematron failed: empty result</error>
            )
        let $transerror             := count($transform/descendant-or-self::error) > 0
        
        let $zipfile := 
            if ($transerror) then () else if ($input instance of element(decor)) then compression:zip(xs:anyURI($schDir), true(), $schDir) else ()
            (: store: let $zip       := xmldb:store($targetDir, concat($schDir, '.zip'), $zipfile):)
        
        (: create ISO schematron conversion to XSL :)
        let $isoschematrons          := $get:strUtilISOSCH2SVRL
        let $path2schematroninclude  := xs:anyURI(concat('xmldb:exist://', $isoschematrons, "/iso_dsdl_include.xsl"))
        let $path2schematronabstract := xs:anyURI(concat('xmldb:exist://', $isoschematrons, "/iso_abstract_expand.xsl"))
        let $path2schematronxsl      := xs:anyURI(concat('xmldb:exist://', $isoschematrons, "/iso_svrl_for_xslt2.xsl"))
        let $isosch-xsltparams :=
            <parameters>
                <param name="allow-foreign" value="true"/>
                <param name="generate-fired-rule" value="true"/>
                <param name="generate-paths" value="true"/>
                <param name="diagnose" value="yes"/>
                <param name="exist:stop-on-error" value="yes"/>
            </parameters>
        let $isosch-serialization-options := 'method=xml media-type=text/xml omit-xml-declaration=no indent=no'
        
        (: store the work-around wrapper XSL here to be picked up later by validator in validate-single-instance :)
        let $xslwrap                :=
            <xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform" xmlns:xs="http://www.w3.org/2001/XMLSchema" version="2.0">
                <xsl:include href="{$path2schematroninclude}"/>
            </xsl:stylesheet>
        let $xslstore               := 
            if ($schDir castable as xs:string) then
            try { 
                let $ttt    := xmldb:store($schDir, 'sch2xsl.xsl', $xslwrap)
                let $tt     := try { sm:chmod(xs:anyURI($ttt), 'rw-rw-r--') } catch * {()}
                
                return $ttt
            } 
            catch * {
                <error>+++ Saving sch2xsl.xsl in the schematron dir failed: {$err:code}: {$err:description} {$err:module} [at line {$err:line-number}]</error>
            }
            else ()
        
        let $errortxt := 
            normalize-space(
                string-join((
                    if (string-length($schDir) = 0 and $input instance of element(decor)) then
                        '+++ Internal: No permission to create collection, check with your admin!'
                    else ()
                    ,
                    $input[. instance of element(error)],
                    $targetDir[. instance of element(error)], 
                    $schDir[. instance of element(error)], 
                    $inclDir[. instance of element(error)], 
                    $transform[. instance of element(error)], 
                    $xslstore[. instance of element(error)]
                ), ' ')
            )
        let $dir :=
            if ($schDir castable as xs:string) then
            <dir>
            {
                for $child in xmldb:get-child-resources($schDir)
                let $path := concat($schDir, '/', $child)
                let $title := doc($path)/*[name() = 'schema']/*[name() = 'title']/text()
                return
                    if (string-length($title) = 0)
                    then ()
                    else <resource name="{$child}" path="{$path}" title="{$title}" ref="{util:uuid()}"/>
            }
            </dir>
            else ()
        
        let $schxsl :=
            if ($transerror) then () else (
                for $input in $dir/resource
                let $input-coll        := string-join(tokenize($input/@path,'/')[not(position()=last())],'/')
                let $input-res         := replace(tokenize($input/@path,'/')[last()],'.sch$','.xsl')
                let $includetransform  := 
                    try {
                        transform:transform(doc($input/@path), doc(xs:anyURI(concat("xmldb:exist://", $input-coll, "/sch2xsl.xsl"))), $isosch-xsltparams, (), $isosch-serialization-options)
                    } catch * {
                        <error>+++ ISO schematron to xsl conversion failed: {$err:code}: {$err:description}</error>
                    }
                let $abstracttransform := 
                    if ($includetransform instance of element(error))
                    then ()
                    else transform:transform($includetransform, $path2schematronabstract, $isosch-xsltparams)
                let $grammartransform  :=
                    if ($includetransform instance of element(error))
                    then ()
                    else transform:transform($abstracttransform, $path2schematronxsl, $isosch-xsltparams)
                let $store             := 
                    if ($includetransform instance of element(error))
                    then ()
                    else (
                        let $ttt    := xmldb:store($input-coll, $input-res, $grammartransform)
                        let $tt     := try { sm:chmod(xs:anyURI($ttt), 'rw-rw-r--') } catch * {()}
                
                        return $ttt
                    )
                return
                    if ($includetransform instance of element(error))
                    then <transform status="failed">{$includetransform}</transform>
                    else <transform coll="{$input-coll}" xsl="{$input-res}" path="{$input/@path}"/>
            )
        
        let $res :=
            <compilation>
            {
                <compiled for="{$projectPrefix}" on="{$now}" as="{$stamp}" by="{$author}" closed="{$doClosed}" explicitIncludes="{$doExplicitIncludes}" status="{if ($transerror) then 'failed' else 'active'}">
                {
                    if ($filters) then 
                        attribute filterlabel {($filters/@label, $filters/@id)[1]} |
                        attribute transactions {$filters/transaction/concat(@ref, '--', @flexibility)}
                    else (),
                    if (string-length($errortxt) = 0) then () else attribute {'error'} {$errortxt},
                    if (string-length($last-survivor-message) = 0) then () else attribute {'lastsurvivormessage'} {$last-survivor-message},
                    $dir,
                    if (empty($zipfile)) then () else <zip>{$zipfile}</zip>
                }
                </compiled>,
                <input>
                {
                    $input
                }
                </input>,
                $schxsl
            }
            </compilation>
        
        let $result         := 
            if ($targetDir castable as xs:string) then (
                let $ttt    := xmldb:store($targetDir, concat($projectPrefix, $stamp, '.xml'), $res)
                let $tt     := try { sm:chmod(xs:anyURI($ttt), 'rw-rw-r--') } catch * {()}
                
                return $ttt
            ) else ()
        
        let $compiledF      := $get:colDecorVersion//compiled[@for = $projectPrefix][ancestor::compilation]
        return
            $data
    )
    else 
    if ($decor and $request = 'download') then (
        (: DOWLOAD ref= OID or UUID to return zip, allow keyword 'dynamic' to get the latest compiled development runtime :)
        (: if $specificref = 'dynamic' then return the last compilation if any, if a uuid return the one specified, otherwise it is in error :)
        let $compilations := $get:colDecorVersion//compiled[@for = $projectPrefix][ancestor::compilation][@status = 'active']
        let $theref                         :=
            if (lower-case($specificref) = 'dynamic')
            then (
                let $latestdt               := max($compilations/xs:dateTime(@on))
                return string($compilations[@on = $latestdt]/@as)
            ) else $specificref
        let $compiledF :=
            if (matches($theref, '[1-9][0-9]*(\.[0-9]+)*|([0-9A-F]{8}-[0-9A-F]{4}-[0-9A-F]{4}-[0-9A-F]{4}-[0-9A-F]{12})'))
            then
                $compilations[@as = $theref]/zip
            else ()
        return
            if ($compiledF) then
                response:stream-binary($compiledF/text(), 'application/zip', concat($theref, '.zip'))
            else
                <results>
                    <errors>
                        <error text="nps">No active download under this identifier</error>
                    </errors>
                    <object name="No active download under this identifier"/>
                </results>
    )
    else 
    if ($decor and $request = 'delete') then (
        (: DELETE ref :)
        let $part1 :=
            if (matches($specificref, '[1-9][0-9]*(\.[0-9]+)*|([0-9A-F]{8}-[0-9A-F]{4}-[0-9A-F]{4}-[0-9A-F]{4}-[0-9A-F]{12})')) then
                concat('xmldb:exist://', $get:strDecorVersion, '/', substring($projectPrefix, 1, string-length($projectPrefix) - 1), '/development/')
            else ()
        let $tmp1 :=
            if ($part1) then
                try {
                    xmldb:remove($part1, concat($projectPrefix, $specificref, '.xml'))
                }
                catch * {
                    <error>+++ Delete schematron set failed (1): {$err:code}: {$err:description}</error>
                }
            else
                <error>+++ Delete schematron set failed (2): no-match: Parameter ref "{$specificref}" is not a valid development id</error>
        let $tmp2 :=
            if ($part1) then
                try {
                    xmldb:remove(concat($part1, $specificref))
                }
                catch * {
                    <error>+++ Delete schematron set failed (3): {$err:code}: {$err:description}</error>
                }
            else
                <error>+++ Delete schematron set failed (4): no-match: Parameter ref "{$specificref}" is not a valid development id</error>
        return
            <results type="delete" ref="{$specificref}">
                <errors>{$tmp1}{$tmp2}</errors>
            </results>
    )
    else (
        <results>
            <errors>
                <error text="nps">Internal error: Missing parameter prefix or transaction identifier</error>
            </errors>
            <object name="Internal error: Missing parameter prefix or transaction identifier"/>
        </results>
    )
