punkshell/src/modules/punk/tdl-999999.0a1.0.tm

# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2023
#
# @@ Meta Begin
# Application punk::tdl 999999.0a1.0
# Meta platform     tcl
# Meta license      <unspecified>
# @@ Meta End



# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
##  Requirements
##e.g package require frobz




# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::tdl {
    # https://wiki.tcl-lang.org/page/Config+file+using+slave+interp

    namespace eval argdoc {
        variable PUNKARGS
    }

    variable sample_script {
        server -name bsd1 -os FreeBSD
        server -name p1 -os linux
        server -name trillion -os windows

        server -name vmhost1 -os FreeBSD {
            guest -name bsd1 -vmmanager bastille
            guest -name p1 -vmmanager bhyve
        }

    }



    namespace eval argdoc {
        variable PUNKARGS
        lappend PUNKARGS [list {
            @id     -id     ::punk::tdl::prettyparse
            @cmd    -name   punk::tdl::prettyparse\
                -summary\
                    "Parse a Tcl-like TDL script into a nested list of dictionaries."\
                -help\
                    "Parse a script in the Tcl Data Language style shown at
                    https://wiki.tcl-lang.org/page/Config+file+using+slave+interp.

                    The script is evaluated in a child interpreter. Unknown commands are captured
                    as data objects: the command name is stored under the reserved 'tag' key,
                    flag/value words become dictionary entries, and an odd final argument is
                    treated as a nested body script and parsed recursively under the reserved
                    'body' key.

                    When safe is true a safe child interpreter is used. When safe is false a
                    normal child interpreter is used, which allows a broader set of Tcl commands
                    to run while parsing. This parser validates Tcl script syntax and list
                    structure only; schema and semantic validation belong to the caller."
            @values -min 1 -max 2
                script  -type string  -help\
                    "TDL-style Tcl script to parse."
                safe    -type boolean -default 1 -optional 1 -help\
                    "Use a safe child interpreter when true, or a normal child interpreter
                      when false."
        }]
    }
    proc prettyparse {script {safe 1}} {
        if {$safe} {
            set i [interp create -safe]
        } else {
            set i [interp create]
        }
        try {
    #       $i eval {unset {*}[info vars]}
    #       foreach command [$i eval {info commands}] {$i hide $command}
    #       $i invokehidden namespace delete {*}[$i invokehidden namespace children]
            $i alias unknown apply {{i tag args} {
                upvar 1 result result
                set e [concat [list tag $tag] [lrange $args 0 [expr {([llength $args] & ~1) - 1}]]]
                if {[llength $args] % 2} {
                    set saved $result
                    set result {}
                    $i eval [lindex $args end]
                    lappend e body $result
                    set result $saved
                }
                lappend result $e
                list
            }} $i
            set result {}
            $i eval $script
            return $result
        } finally {
            interp delete $i
        }
    }

    namespace eval argdoc {
        variable PUNKARGS
        lappend PUNKARGS [list {
            @id     -id     ::punk::tdl::prettyprint
            @cmd    -name   punk::tdl::prettyprint\
                -summary\
                    "Render parsed TDL dictionaries back to a readable Tcl-like script."\
                -help\
                    "Render the nested list of dictionaries returned by punk::tdl::prettyparse as
                    an indented Tcl-like data script.

                    The reserved 'tag' key supplies each command name. Remaining dictionary keys
                    are emitted as arguments, and a non-empty reserved 'body' key is rendered
                    recursively inside braces. Comments and original whitespace are not preserved."
            @values -min 1 -max 2
                data    -type list    -help\
                    "Nested list of dictionaries in the representation returned by
                      punk::tdl::prettyparse."
                level   -type integer -default 0 -optional 1 -help\
                    "Initial indentation level, primarily used for recursive rendering."
        }]
    }
    proc prettyprint {data {level 0}} {
        set ind [string repeat "    " $level]
        incr level
        set result {}
        foreach e $data {
            set line $ind[concat [list [dict get $e tag]] [dict remove $e tag body]]
            if {[dict exists $e body] && [llength [dict get $e body]]} {
                append line " {\n[prettyprint [dict get $e body] $level]\n$ind}"
            }
            lappend result $line
        }
        join $result \n
    }


}




namespace eval ::punk::args::register {
    #use fully qualified so 8.6 doesn't find existing var in global namespace
    lappend ::punk::args::register::NAMESPACES ::punk::tdl
}



# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
##  Ready
package provide punk::tdl [namespace eval punk::tdl {
    variable version
    set version 999999.0a1.0
}]
return