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

(:
    Clears one or more datasets from history elements, and any concepts that match a certain status. By default, no 
    concepts are deleted. Possible statuses are cancelled/rejected/deprecated. Example calls
    
    ?prefix=demo1-                                              Clears history in all demo1- datasets
    ?prefix=demo1-&prefix=demo2-                                Clears history in all demo1- and demo2- datasets
    ?prefix=demo1-&id=2.16.840.1.113883.2.4.3.11.60.108.1.1     Clears history in demo1- under this dataset id
    ?prefix=demo1-&status=cancelled                             Clears history and cancelled concepts in all demo1- datasets
    ?prefix=demo1-&status=cancelled&status=rejected             Clears history and cancelled or rejected concepts in all demo1- datasets
    
    Add testonly=false to any of these queries to actually execute everything. Otherwise it will only return what it would have done
    
    Notes:
        - User must be a registered author for the project
        - Leaves project/version containing actions performed
        - Does NOT check any locks applicable to the dataset or contained concepts
        - Does NOT check dependencies of deleted concepts. DEPENDENCIES ARE CONSIDERED YOUR OWN RESPONSABILITY

    Parameter prefix    1..*. Error if empty. Without parameter $datasetId it will clear all datasets
    
    Parameter id        0..*. If given then only datasets with this id/effectiveDate when found in project(s) are cleared
                              Format OID[;;dateTime] 
                        example: 2.16.840.1.113883.2.4.3.11.60.108.1.1;;2015-09-16T14:21:51     (all datasets with this id / effectiveDate)
                        example: 2.16.840.1.113883.2.4.3.11.60.108.1.1                          (all dataset versions with this id)
    
    Parameter status    0..*. If given then concepts matching any of these statuses are deleted. Only cancelled, 
                              rejected and deprecated are supported
:)

declare variable $statusNew         := 'new';
declare variable $statusCancelled   := 'cancelled';
declare variable $statusRejected    := 'rejected';
declare variable $statusDeprecated  := 'deprecated';
declare variable $statusCodes       := ($statusNew,$statusCancelled,$statusRejected,$statusDeprecated);

declare variable $local:testonly    := if (request:exists()) then request:get-parameter('testonly','true')='true' else ('true');

(: Expected input: 0..* datasets from 1 project.
    collects inline history/concepts to delete, deletes those.
    if this function deletes stuff, a copy of the dataset is stored in history before doing that 
    and a project/version listing the deletion count per type is added :)
declare %private function local:clearDatasets($datasets as element(dataset)*, $deleteStatuses as xs:string*) as element(version)* {
    let $decorProject   := $datasets/ancestor::decor/project
    let $prefix         := $decorProject[1]/@prefix
    let $language       := $decorProject[1]/@defaultLanguage
    
    let $datasetVersionInfo := 
        for $dataset in $datasets
        let $history            := $dataset//history
        let $newConcepts        := 
            if ($statusNew = $deleteStatuses) 
            then $dataset//concept[@statusCode = $statusNew][not(ancestor::history)] 
            else ()
        let $cancelledConcepts  := 
            if ($statusCancelled = $deleteStatuses) 
            then $dataset//concept[@statusCode = $statusCancelled][not(ancestor::history)] 
            else ()
        let $rejectedConcepts   := 
            if ($statusRejected = $deleteStatuses) 
            then $dataset//concept[@statusCode = $statusRejected][not(ancestor::history)] 
            else ()
        let $deprecatedConcepts := 
            if ($statusDeprecated = $deleteStatuses) 
            then $dataset//concept[@statusCode = $statusDeprecated][not(ancestor::history)] 
            else ()
        
        (: build project/version element to insert into the project after the deletions are done :)
        let $versionInfo        := local:getVersionFragment($dataset,(count($history), count($newConcepts), count($cancelledConcepts), count($rejectedConcepts), count($deprecatedConcepts)), $language)
        
        (: execute only if $local:testonly is false() :)
        let $execute            :=
            if ($local:testonly) then () else (
                (: save dataset as it was before deletions into separate history :)
                let $saveHistory        := 
                    if ($history | $newConcepts | $cancelledConcepts | $rejectedConcepts | $deprecatedConcepts) then 
                        hist:AddHistory ($decor:OBJECTTYPE-DATASET, $prefix, 'version', $dataset)
                    else ()
                
                (: delete all top level history, which deletes contained history too :)
                let $clearDataset       := 
                    try {
                        update delete $history[not(ancestor::history)]
                    } catch * {()}
                (: delete all top level concepts based on status, which deletes contained concepts too :)
                let $clearDataset       := 
                    try {
                        update delete ($newConcepts | $cancelledConcepts | $rejectedConcepts | $deprecatedConcepts)[not(ancestor::concept[@statusCode = $deleteStatuses])]
                    } catch * {()}
                
                return ()
             )
        return  $versionInfo
    
    let $versionInfo        :=
        <version by="{get:strCurrentUserName()}" date="{substring(string(current-dateTime()),1, 19)}">
            <desc language="{$language[1]}">Automated cleanup on one or more datasets ({count($datasets)}).
            { 
                if ($datasetVersionInfo) then (
                    <ul>{$datasetVersionInfo}</ul>,
                    'Please note that dependencies in concepts (inherit), transactions, terminology and/or templates have NOT been checked.'
                ) else ()
            }
            </desc>
        </version>
    
    (: execute only if $local:testonly is false() :)
    let $insertVersion      := 
        if ($local:testonly or empty($datasetVersionInfo)) then () else (
            (: store record of deletions as project/version :)
            if ($decorProject[release | version]) then
                update insert $versionInfo preceding $decorProject/(release | version)[1]
            else
                update insert $versionInfo into $decorProject
        )
    return $versionInfo
};

(: build project/version element to insert into the project. This lists the actions. :)
declare %private function local:getVersionFragment($dataset as element(dataset), $counts as xs:integer*, $language as xs:string) as element(version)? {
    let $datasetName    := if ($dataset/name[@language = $language]) then $dataset/name[@language = $language] else $dataset/name[1]

    return
        <li>Dataset "{$datasetName//text()}" ({$dataset/@id/string()} / {$dataset/@effectiveDate/string()}). Totals: 
            <ul>{
                if (exists($counts[. > 0])) then (
                <ul>
                    {if ($counts[1]>0) then <li>Inline concept history removed: {$counts[1]}</li> else ()}
                    {if ($counts[2]>0) then <li>New concepts removed: {$counts[2]}</li> else ()}
                    {if ($counts[3]>0) then <li>Cancelled concepts removed: {$counts[3]}</li> else ()}
                    {if ($counts[4]>0) then <li>Rejected concepts removed: {$counts[4]}</li> else ()}
                    {if ($counts[5]>0) then <li>Deprecated concepts removed: {$counts[5]}</li> else ()}
                </ul>
                ) else ( 'no changes required.' )
            }</ul>
        </li>
};

let $projectPrefixes        := if (request:exists()) then request:get-parameter('prefix',())[not(.='')] else ('demo1-')
let $datasetIds             := if (request:exists()) then request:get-parameter('id',())[not(.='')] else ()
let $deleteStatuses         := if (request:exists()) then request:get-parameter('status',())[not(.='')] else ($statusCodes)

let $currentUser            := get:strCurrentUserName()

let $check                  :=
    if ($projectPrefixes) then (
        for $prefix in $projectPrefixes
        return 
        if (decor:authorCanEdit($prefix, $decor:SECTION-DATASETS)) then () else (
            error(xs:QName('decor:InsufficientPermissions'),concat('User ''',$currentUser,''' can not author datasets in project ''',$prefix,''''))
        )
    ) else (
        error(xs:QName('decor:InsufficientParameters'),'Parameter prefix is required and may repeat. Parameter id (format id[;;effectiveDate]) is optional and may repeat. It should contain dataset id/effectiveDate to clean.')
    )
    
let $datasets               :=
    for $prefix in $projectPrefixes
    return art:getDatasets($prefix)
    
let $datasets               :=
    if ($datasetIds) then (
        for $datasetId in $datasetIds
        let $id             := tokenize($datasetId,';;')[1]
        let $effectiveDate  := tokenize($datasetId,';;')[2]
        return
            if ($effectiveDate castable as xs:dateTime)
            then $datasets[@id = $id][@effectiveDate = $effectiveDate]
            else $datasets[@id = $id]
    ) else ($datasets)

let $clear                  := 
    for $datasetsByPrefix in $datasets
    let $prefix                 := $datasetsByPrefix/ancestor::decor/project/@prefix
    group by $prefix
    return 
        <project>
        {
            $datasetsByPrefix[1]/ancestor::decor/project/@*,
            $datasetsByPrefix[1]/ancestor::decor/project/name,
            local:clearDatasets($datasetsByPrefix, $deleteStatuses)
        }
        </project> 

return
    <result testonly="{$local:testonly}">
    {
        if ($local:testonly) then
            <message>No actual action was applied to your project(s). Add parameter testonly=false to execute.</message>
        else (
            <message>Actions were applied to your project(s). Omit parameter testonly, or change to testonly=true to just test.</message>
        )
        ,
        $clear
    }
    </result>