Artifact 8297b54f5db57aa3623ade0488c56d7fe262f1070b1a8c0a966d948c45b08ae6:

• Executable file tag-page/generate.tcl — part of check-in [28c4affefa] at 2021-01-07 19:34:17 on branch trunk — docs(tag-page): update copyright (user: dbohdan, size: 3908) [annotate] [blame] [check-ins using]

#! /usr/bin/env tclsh
# Generate a tag page for a Fossil wiki.
# Copyright (c) 2020, 2021 D. Bohdan.
# License: MIT.
# Typical usage in an open Fossil repository:
# $ ./generate.tcl . | ../update-wiki-page.tcl special:tags

package require Tcl 8.6
package require sqlite3


proc main repo {
    set db page-db
    sqlite3 $db :memory:

    $db eval {
        CREATE TABLE pages(
            name TEXT PRIMARY KEY,
            h1 TEXT,
            contents TEXT
        );

        CREATE TABLE tags(
            page TEXT,
            tag TEXT,
            FOREIGN KEY (page) REFERENCES pages(name),
            PRIMARY KEY (page, tag)
        );
    }

    $db transaction {
        foreach {name h1 contents} [pages-with-contents $repo] {
            $db eval {
                INSERT INTO pages(name, h1, contents)
                VALUES (:name, :h1, :contents);
            }

            foreach tag [page-tags $contents] {
                $db eval {
                    INSERT INTO tags(page, tag)
                    VALUES (:name, :tag);
                }
            }
        }
    }

    set attrs {}
    set attrNames {name h1}
    set grouped {}
    set prevTag {}

    $db eval {
        SELECT
            tags.tag,
            h1,
            name
        FROM tags
        INNER JOIN pages
        ON tags.page = pages.name
        INNER JOIN (
            SELECT
                tag,
                (-count(page) +
                    CASE WHEN tag = 'redirect' THEN 10000 ELSE 0 END)
                AS tag_score
            FROM tags
            INNER JOIN pages
            ON tags.page = pages.name
            GROUP BY tag
        ) AS scores
        ON tags.tag = scores.tag
        ORDER BY
            tag_score,
            tags.tag,
            h1,
            name
        COLLATE NOCASE ASC;
    } row {
        if {$row(tag) ne $prevTag} {
            if {$prevTag ne {}} {
                lappend grouped $prevTag {*}[lmap attr $attrNames {
                    dict get $attrs $attr
                }]

                set attrs {}
            }

            set prevTag $row(tag)
        }

        foreach attr $attrNames {
            dict lappend attrs $attr $row($attr)
        }
    }

    lappend grouped $prevTag {*}[lmap attr $attrNames {
        dict get $attrs $attr
    }]

    puts [tag-page $grouped]
}


proc pages-with-contents repo {
    set pages {}

    foreach name [split [fossil wiki ls $repo] \n] {
        set contents [fossil wiki export $name]
        set h1 {}
        regexp {^#\s*([^\n]+)\n} $contents _ h1
        lappend pages $name $h1 $contents
    }

    return $pages
}


proc fossil args {
    exec -ignorestderr fossil {*}$args
}


proc page-tags text {
    if {[regexp -nocase {\n\[Tags\]\([^)]+\): ([^\.\n]+)} $text _ tags]} {
        return [lmap x [split $tags ,] {string trim $x}]
    } else {
        return {}
    }
}


proc tag-page sorted {
    set lines [list]

    lappend lines {# Pages by tag} {## Contents}
    lappend lines {## Tags} [markdown-list $sorted ###]

    return [join $lines \n]
}


proc markdown-list {grouped prefix} {
    set markdown [list]
    set esc {
        [ \\[
        ] \\]
        ( \\(
        ) \\)
    }

    foreach {tag pages h1s} $grouped {
        set section [list "$prefix $tag"]

        foreach page $pages h1 $h1s {
            set text $page
            if {$h1 ne {}} {
                set text $h1
            }
            set target [string map [list \
                { } + \
                ? %3f \
                {*}$esc \
            ] $page]

            set link \[[string map $esc $text]\](/wiki/$target)
            lappend section "* $link"
        }

        lappend markdown [join $section \n]
    }

    join $markdown \n\n
}


# If this is the main script...
if {[info exists argv0] && ([file tail [info script]] eq [file tail $argv0])} {
    puts [main {*}$argv]
}