teisimplehelpers.xqm

xquery version "3.1";

(:~
 : This module contains a potpourri of functions that are needed to serialize
 : the TEI simplePrint version of the Fontane TEI encoding.
 :
 : @author Michelle Weidling
 : @version 1.0
 :)

module namespace simpleHelpers="http://fontane-nb.dariah.eu/teisimplehelpers";

declare namespace tei="http://www.tei-c.org/ns/1.0";

import module namespace console="http://exist-db.org/xquery/console";
import module namespace config="http://textgrid.de/ns/SADE/config" at "../../config/config.xqm";
import module namespace functx = "http://www.functx.com";


(: TODO: adapt to general XML :)
(:~
 : Determines whether the passed tei:milestone is contemporary or not.
 :
 : TODO: check if we reach backside of calendar pages at all
 : @author Michelle Weidling
 : @param $hand the tei:milestone/@subtype or tei:mod/@hand to be checked
 : @return xs:boolean
 :)
declare function simpleHelpers:is-hand-contemporary($hand as xs:string?)
as xs:boolean {
    let $hand := replace($hand, "#", "")
    let $file := doc("/db/sade-projects/textgrid/data/xml/data/16b00.xml")
    let $handNote := $file//tei:handNote[@xml:id = $hand]
    return
        if($handNote/@script = "contemporary")
            then
                true()
            else
                false()
};


(:~
 : Checks if a node is transposed, i.e. if is encoded at another place than it
 : should be serialized.
 :
 : TODO: doesn't work at the moment
 :
 : @author Michelle Weidling
 : @param $node the current TEI node to be checked
 : @return xs:boolean
 :)
declare function simpleHelpers:is-transposed($node as node())
as xs:boolean {
    let $root := $node/ancestor::tei:TEI
    return
        if($root//tei:ptr[contains(@target, $node/@xml:id)]) then
            true()
        else
            false()
};


(:~
 : Performs a couple of processing steps on a text node:
 :
 : 1.   for the edited text only hyphens that are marked with
 :      <tei:lb break="keepHyphen"/> should be displayed
 : 2.   round s (ſ) is normalized to "s"
 : 3.   the Tironian note is normalized to "etc.""
 : 4.   inserts an additional whitespace if a line ends with a character (TODO)
 :
 : @author Michelle Weidling
 : @param $node the current text node
 : @return text() the formatted text
 : :)
declare function simpleHelpers:prepare-text($node as text()) as text()? {
    if(not(normalize-space($node) = "")) then
        (: the @ serves as a flag for the removal of hyphens. this is necessary
        since we sometimes have cases where a hyphen is the only content of a 
        string. functx:substring-before-last would therefore produce an empty
        string which leads to problems while preparing the text any further. :)
        let $cleared-end-hyphen :=
            if((ends-with($node, "-") or ends-with($node, "⸗"))
            and $node/parent::tei:add) then
                $node
            else if(ends-with($node, "-") and not(simpleHelpers:keep-hyphen($node))) then
                text {functx:substring-before-last($node, "-") || "@P"}
            else if(ends-with($node, "⸗") and not(simpleHelpers:keep-hyphen($node))) then
                text {functx:substring-before-last($node, "⸗") || "@P"}
            else
                replace($node, "⸗", "-")
        let $cleared-hyphen := replace($cleared-end-hyphen, "⸗", "-")
        let $cleared-round-s := replace($cleared-hyphen, "ſ", "s")
        let $cleared-Tironian := replace($cleared-round-s, "&#x204a;c.", "etc.")
(:        let $normalized := normalize-space($cleared-round-s):)
(:        let $last-char := substring($cleared-round-s, string-length($cleared-round-s), 1):)
(:        let $add-whitespace := :)
(:            if(matches($last-char, "[\w\d,\.;?!]"):)
(:            and $node/parent::tei:line/child::*[last()] = . ) then:)
(:                $cleared-round-s || " ":)
(:            else:)
(:                $cleared-round-s:)
(:        return text {$add-whitespace}:)
        return 
            (: in cases where a given $node only consists of a hyphen we don't
            return a text node because it's unnecessary and leads to problems 
            while testing. :)
            if(matches($cleared-Tironian, "@P") 
            and string-length($cleared-Tironian) gt 1
            or not(matches($cleared-Tironian, "@P"))) then
                text {$cleared-Tironian}
            else
                ()
    else
        ()
};


(:~
 : Checks if a hyphen should be kept for the edited text or not.
 :
 : @author Michelle Weidling
 : @param $node the current text node
 : @return xs:boolean
 :)
declare function simpleHelpers:keep-hyphen($node as text()) as xs:boolean {
    if($node/ancestor::tei:line/following-sibling::*[1][self::tei:lb[@break = "keepHyphen"]])
        then
            true()
    else
        false()
};


(:~
 : Checks if the current node has valid text.
 :
 : @author Michelle Weidling
 : @param $node
 : @return xs:boolean
 :)
declare function simpleHelpers:has-valid-text($node as node()) as xs:boolean {
    let $text-nodes := $node/descendant::text()[not(normalize-space(.) = "")]
    let $results :=
        for $text-node in $text-nodes
            return
                simpleHelpers:is-valid-text($text-node)
    return
        if(functx:is-value-in-sequence(true(), $results)) then
            true()
        else
            false()
};


(:~
 : Checks if a text node has valid text. A text is valid if it is written by a
 : contemporary hand or by Friedrich Fontane (in case it's text on a label or
 : on a calendar (TODO)). The same holds for notes of the modern editors which
 : are marked by @type = "edited_text".
 :
 : @author Michelle Weidling
 : @node a text node
 : @return xs:boolean
 :)
declare function simpleHelpers:is-valid-text($node as text()) as xs:boolean {
    let $current-hand := $node/preceding::tei:milestone[@unit = "handshift"][@subtype][1]/@subtype
    return
    if((simpleHelpers:is-hand-contemporary($current-hand)
    or ($node[ancestor::tei:surface[@type = "label"]]
        and matches($current-hand, "Friedrich_Fontane"))
    or $node/ancestor::*[@type = "edited_text"]
    or $node/ancestor::tei:figDesc)
    and not(normalize-space($node) = "")) then
        true()
    else
        false()
};

(:~
 : Checks if the current tei:surface is a page. Pages can be recognized by their
 : pagination (e.g. 4v) in the node's @n.
 :
 : @author Michelle Weidling
 : @node element(tei:surface)
 : @return xs:boolean
 :)
declare function simpleHelpers:is-page($node as element(tei:surface))
as xs:boolean {
    matches($node/@n, "[0-9IVXMCD]{1,7}[rv]{1}")
};


(:~
 : Retrieves the font size from the @style of a tei:seg.
 :
 : @author Michelle Weidling
 : @param $node the current tei:line, tei:zone or tei:seg node with @type = heading
 : @return xs:string the font size value
 : :)
declare function simpleHelpers:get-font-size($node as node()) as xs:string {
    (: example for style: "font-size:large; letter-spacing:0.2cm; text-decoration:underline" :)
    let $tmp := substring-after($node/descendant-or-self::tei:seg[matches(@style, "font-size") and not(ancestor::tei:add[@place = "above"])]/@style, "font-size:")
    return 
        if(matches($tmp, ";")) then
            substring-before($tmp, ";")
        else
            $tmp
};


(:~
 : Checks if a node's @style attribute contains any relevant information.
 :
 : @author Michelle Weidling
 : @param $node the current tei:zone, tei:line, or tei:seg node
 : @return xs:boolean
 :)
declare function simpleHelpers:has-valid-style($node as node())
as xs:boolean {
    let $style := $node/@style
    return
        if(matches($style, "font")
        or matches($style, "align")
        or matches($style, "spacing")
        or matches($style, "uppercase")
        or matches($style, "color:red")
        or matches($style, "black_letter")
        or matches($style, "roman")
        or matches($style, "line-through")) then
            true()
        else
            false()
};


(:~
 : Returns a sequence of strings containing renditions that are relevant for an
 : element in the edited text and are merged into a single @rendition.
 :
 : Since this information can be held either in a node's @style or in its
 : @rendition, we have to check both of them separately before combining them
 : into one element for convenience reasons.
 : TODO: check if @rendition is the right attribute for that
 :
 : @author Michelle Weidling
 : @param $node the current tei:zone, tei:line, or tei:seg element
 : @return a string of all relevant information
 :)
declare function simpleHelpers:filter-rendition($node as node()) as xs:string* {
    let $styles := tokenize($node/@style, " ")
    let $relevant-styles :=
        for $style in $styles
        return
            if(matches($style, "font")
            or matches($style, "align")
            or matches($style, "spacing")
            or matches($style, "uppercase")
            or matches($style, "color:red")
            or matches($style, "black_letter")
            or matches($style, "roman")
            or matches($style, "line-through")) then
                $style
            else
                ()
    let $transformed-renditions :=
        for $rend in tokenize($node/@rendition, " ")
            return
                if(matches($rend, "black_letter")) then
                    "black_letter"
                else if(matches($rend, "roman")) then
                    "roman"
                else
                    if(matches($rend, "#")) then
                        substring-after($rend, "#")
                    else
                        $rend
    let $new-renditions := ($relevant-styles, $transformed-renditions)
    return string-join($new-renditions, " ")
};


(:~
 : Checks if the current hand is valid. For the edited text we only need to
 : consider contemporary hands/prints or additions by Friedrich Fontane if they
 : occur on labels and on the backside of calendar pages.
 :
 : TODO check if we reach calendar pages
 : @author Michelle Weidling
 : @param $hands a string sequence containing all contemporary hands that are
 :          declared in tei:handNotes
 : @param $node the current tei:milestone[@unit = "handshift"] element
 : @return xs:boolean
 :)
declare function simpleHelpers:is-hand-valid($hands as xs:string*,
$node as element(tei:milestone)) as xs:boolean {
    let $current-hand := replace($node/@subtype, "#", "")
    return
        if(functx:is-value-in-sequence($current-hand, $hands)
        or ($node/ancestor::*[@type = ("label", "toc")]
            and matches($current-hand, "Friedrich_Fontane"))
        ) then
            true()
        else
            false()
};


declare function simpleHelpers:belongs-to-valid-hand($hands as xs:string*,
$node as element(*)*) as xs:boolean {
    (: in some cases elements like tei:front or tei:body don't have a preceeding
    tei:milestone[@unit = "handshift"] because the initial pages are empty. 
    in these cases we want to preserve the element and therefore set a valid 
    tei:milestone[@unit = "handshift"] :)
    let $prev-hand :=
        if($node/preceding::tei:milestone[@unit = "handshift"][1]) then
            $node/preceding::tei:milestone[@unit = "handshift"][1]
        else
            <tei:milestone unit="handshift" subtype="#Fontane"/>
    return
        if(simpleHelpers:is-hand-valid($hands, $prev-hand)) then
            true()
        else
            false()
};


declare function simpleHelpers:find-prev-valid-hand($hands as xs:string*, 
$node as element(tei:milestone)) as element(tei:milestone){
    $node/preceding::tei:milestone[@unit = "handshift"][1][simpleHelpers:is-hand-valid($hands, $node)]
};

(:~
 : Checks if the previous milestone[@unit = "handshift"] is the same as the 
 : current milestone[@unit = "handshift"]. They are the same if they have the 
 : same attributes.
 :
 : @author Michelle Weidling
 : @param $node the current tei:milestone[@unit = "handshift"] element
 : @return xs:boolean
 :)
declare function simpleHelpers:is-prev-valid-hand-same($hands as xs:string,
$node as element(tei:milestone)) as xs:boolean {
    let $prev-valid-hand := simpleHelpers:find-prev-valid-hand($hands, $node)
    let $prev-hand := $node/preceding::tei:milestone[@unit = "handshift"][1]
    return
        (: since we can't take the order of the attributes for granted we can't
        use functx:sequence-deep-equal :)
        if($prev-hand
        and $prev-hand = $prev-valid-hand
        and $node/@subtype = $prev-hand/@subtype
        and $node/@rend = $prev-hand/@rend) then
            true()
        else
            false()
};

(:~
 : Checks if the previous milestone[@unit = "handshift"] is the same as the 
 : current milestone[@unit = "handshift"]. They are the same if they have the 
 : same attributes.
 :
 : @author Michelle Weidling
 : @param $node the current tei:milestone[@unit = "handshift"] element
 : @return xs:boolean
 :)
declare function simpleHelpers:is-prev-hand-same($node as element(tei:milestone)) 
as xs:boolean {
    let $prev-hand := $node/preceding::tei:milestone[@unit = "handshift"][1]
    return
        (: since we can't take the order of the attributes for granted we can't
        use functx:sequence-deep-equal :)
        if($prev-hand
        and $node/@subtype = $prev-hand/@subtype
        and $node/@rend = $prev-hand/@rend) then
            true()
        else
            false()
};


(: TODO :)
(:declare function simpleHelpers:make-section($node as element(tei:milestone))
as element(tei:section) {
    let $id := substring-after($node/@spanTo, "#")
    let $corresp := $node/following::*[$id = @xml:id]
    let $bla := console:log(util:get-fragment-between($node, $corresp, true(), true()))
    return
        <div/>
};:)

declare function simpleHelpers:find-chars($node as element(tei:lb)) as node()* {
    let $prev-line := $node/preceding::tei:line[1]
    let $prev-last-text := $prev-line/text()[last()]
    let $prev-length := string-length($prev-last-text)
    let $prev-char := substring($prev-last-text, $prev-length,$prev-length)
    
    let $next-line := $node/following::tei:line[1]
    let $next-first-text := $next-line/text()[1]
    let $next-char := substring($next-first-text, 1, 1)   
    
    let $milestone :=
        element {QName("http://www.tei-c.org/ns/1.0", "milestone")} {
            attribute unit {"line"}
        }
    
    return 
        (text{$prev-char}, $milestone,  text {$next-char})
    
};

declare function simpleHelpers:trim-last-char($node as element(tei:line)) 
as text() {
    let $length := string-length($node/string())
    let $trim-last-char := substring($node/string(), 1, $length - 1)
    return text{$trim-last-char}
};

declare function simpleHelpers:trim-first-char($node as element(tei:line)) 
as text() {
    let $length := string-length($node/string())
    let $trim-first-char := substring($node/string(), 2, $length)
    return text{$trim-first-char}
};

declare function simpleHelpers:start-line($node as element()) 
as element(tei:milestone) {
    element {QName("http://www.tei-c.org/ns/1.0", "milestone")} {
        attribute unit {"line"},
        if($node/@rend) then
            attribute rendition {$node/@rend}
        else
            ()
    }
};

declare function simpleHelpers:assure-dir-available($dir-name as xs:string) {
    if(xmldb:collection-available($config:app-root || $dir-name)) then
        ()
    else
        xmldb:create-collection($config:app-root, $dir-name)
};

(:~ Checks if a text node that begins with a whitespace needs trimming at its
 : start.
 :  :)
declare function simpleHelpers:is-trimming-necessary($text as text()) {
    let $second-character := substring($text, 2, 2)

    return 
        if(matches($second-character, "[A-Z(]")) then
            false()
        else
            true()
};