# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake  to update from <pkg>-buildversion.txt
# module template: punkshell/src/decktemplates/vendor/punk/modules/template_module-0.0.2.tm
#
# 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) Julian Noble 2024
#
# @@ Meta Begin
# Application argparsingtest 999999.0a1.0
# Meta platform     tcl
# Meta license      MIT 
# @@ Meta End


# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[manpage_begin punkshell_module_argparsingtest 0 999999.0a1.0]
#[copyright "2024"]
#[titledesc {Module API}]  [comment {-- Name section and table of contents description --}]
#[moddesc {-}]             [comment {-- Description at end of page heading --}] 
#[require argparsingtest]
#[keywords module]
#[description]
#[para] -

# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++

#*** !doctools
#[section Overview]
#[para] overview of argparsingtest
#[subsection Concepts]
#[para] -


# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
##  Requirements
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++

#*** !doctools
#[subsection dependencies]
#[para] packages used by argparsingtest
#[list_begin itemized]

package require Tcl 8.6-
package require punk::args
package require struct::set
#*** !doctools
#[item] [package {Tcl 8.6}]
#[item] [package {punk::args}]

# #package require frobz
# #*** !doctools
# #[item] [package {frobz}]

#*** !doctools
#[list_end]

# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++

#*** !doctools
#[section API]

# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# oo::class namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval argparsingtest::class {
    #*** !doctools
    #[subsection {Namespace argparsingtest::class}]
    #[para] class definitions
    if {[info commands [namespace current]::interface_sample1] eq ""} {
        #*** !doctools
        #[list_begin enumerated]

        # oo::class create interface_sample1 {
        #     #*** !doctools
        #     #[enum] CLASS [class interface_sample1]
        #     #[list_begin definitions]

        #     method test {arg1} {
        #         #*** !doctools
        #         #[call class::interface_sample1    [method test] [arg arg1]]
        #         #[para] test method
        #         puts "test: $arg1"
        #     }

        #     #*** !doctools
        #     #[list_end] [comment {-- end definitions interface_sample1}]
        # }

        #*** !doctools
        #[list_end] [comment {--- end class enumeration ---}]
    }
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++

# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Base namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval argparsingtest {
    namespace export {[a-z]*}  ;# Convention: export all lowercase
    #variable xyz

    #*** !doctools
    #[subsection {Namespace argparsingtest}]
    #[para] Core API functions for argparsingtest 
    #[list_begin definitions]

    proc test1_ni {args} {
        set defaults [dict create\
            -return string\
            -frametype \uFFEF\
            -show_edge \uFFEF\
            -show_seps \uFFEF\
            -x ""\
            -y b\
            -z c\
            -1 1\
            -2 2\
            -3 3\
        ]
        foreach {k v} $args {
            if {$k ni [dict keys $defaults]} {
               error "unrecognised option '$k'. Known options [dict keys $defaults]"
            }
        }
        set opts [dict merge $defaults $args]
    }
    proc test1_switchmerge {args} {
        set defaults [dict create\
            -return string\
            -frametype \uFFEF\
            -show_edge \uFFEF\
            -show_seps \uFFEF\
            -x ""\
            -y b\
            -z c\
            -1 1\
            -2 2\
            -3 3\
        ]
        foreach {k v} $args {
            switch -- $k {
                -return - -show_edge - -show_seps - -frametype - -x - -y - -z - -1 - -2 - -3 {}
                default {
                    error "unrecognised option '$k'. Known options [dict keys $defaults]"
                }
            }
        }
        set opts [dict merge $defaults $args]
    }
    #if we need to loop to test arg validity anyway - then dict set as we go is slightly faster than a dict merge at the end
    proc test1_switch {args} {
        set opts [dict create\
            -return string\
            -frametype \uFFEF\
            -show_edge \uFFEF\
            -show_seps \uFFEF\
            -x ""\
            -y b\
            -z c\
            -1 1\
            -2 2\
            -3 3\
        ]
        foreach {k v} $args {
            switch -- $k {
                -return - -show_edge - -show_seps - -frametype - -x - -y - -z - -1 - -2 - -3 {
                    dict set opts $k $v
                }
                default {
                    error "unrecognised option '$k'. Known options [dict keys $opts]"
                }
            }
        }
        return $opts
    }
    variable switchopts
    set switchopts [dict create\
        -return string\
        -frametype \uFFEF\
        -show_edge \uFFEF\
        -show_seps \uFFEF\
        -x ""\
        -y b\
        -z c\
        -1 1\
        -2 2\
        -3 3\
    ]
    #slightly slower than just creating the dict within the proc
    proc test1_switch_nsvar {args} {
        variable switchopts
        set opts $switchopts
        foreach {k v} $args {
            switch -- $k {
                -return - -show_edge - -show_seps - -frametype - -x - -y - -z - -1 - -2 - -3 {
                    dict set opts $k $v
                }
                default {
                    error "unrecognised option '$k'. Known options [dict keys $opts]"
                }
            }
        }
        return $opts
    }
    proc test1_switch2 {args} {
        set opts [dict create\
            -return string\
            -frametype \uFFEF\
            -show_edge \uFFEF\
            -show_seps \uFFEF\
            -x ""\
            -y b\
            -z c\
            -1 1\
            -2 2\
            -3 3\
        ]
        set switches [lmap v [dict keys $opts] {list $v -}]
        set switches [concat {*}$switches]
        set switches [lrange $switches 0 end-1]
        foreach {k v} $args {
            switch -- $k\
            {*}$switches  {
                dict set opts $k $v
            }\
            default {
                    error "unrecognised option '$k'. Known options [dict keys $opts]"
            }
        }
        return $opts
    }
    proc test1_prefix {args} {
        set opts [dict create\
            -return string\
            -frametype \uFFEF\
            -show_edge \uFFEF\
            -show_seps \uFFEF\
            -x ""\
            -y b\
            -z c\
            -1 1\
            -2 2\
            -3 3\
        ]
        foreach {k v} $args {
            dict set opts [tcl::prefix::match -message "test1_prefix option $k" {-return -frametype -show_edge -show_seps -x -y -z -1 -2 -3} $k] $v
        }
        return $opts
    }
    proc test1_prefix2 {args} {
        set opts [dict create\
            -return string\
            -frametype \uFFEF\
            -show_edge \uFFEF\
            -show_seps \uFFEF\
            -x ""\
            -y b\
            -z c\
            -1 1\
            -2 2\
            -3 3\
        ]
        if {[llength $args]} {
            set knownflags [dict keys $opts]
        }
        foreach {k v} $args {
            dict set opts [tcl::prefix::match -message "test1_prefix2 option $k" $knownflags $k] $v
        }
        return $opts
    }

    #punk::args is slower than argp - but comparable, and argp doesn't support solo flags
    proc test1_punkargs {args} {
        set argd [punk::args::parse $args withdef {
            @id     -id  ::argparsingtest::test1_punkargs 
            @cmd    -name argtest4 -help "test of punk::args::get_dict comparative performance"
            @opts   -anyopts 0
            -return     -default string -type string
            -frametype  -default \uFFEF -type string
            -show_edge  -default \uFFEF -type string
            -show_seps  -default \uFFEF -type string
            -join       -type none -multiple 1
            -x          -default "" -type string
            -y          -default b -type string
            -z          -default c -type string
            -1          -default 1 -type boolean
            -2          -default 2 -type integer
            -3          -default 3 -type integer
            @values
        }]
        return [tcl::dict::get $argd opts]
    }

    punk::args::define {
        @id     -id ::test1_punkargs_by_id
        @cmd    -name argtest4 -help "test of punk::args::get_dict comparative performance"
        @opts   -anyopts 0
        -return     -default string -type string
        -frametype  -default \uFFEF -type string
        -show_edge  -default \uFFEF -type string
        -show_seps  -default \uFFEF -type string
        -join       -type none -multiple 1
        -x          -default "" -type string
        -y          -default b -type string
        -z          -default c -type string
        -1          -default 1 -type boolean
        -2          -default 2 -type integer
        -3          -default 3 -type integer
        @values
    }
    proc test1_punkargs_by_id {args} {
        set argd [punk::args::get_by_id ::test1_punkargs_by_id $args]
        return [tcl::dict::get $argd opts]
    }

    punk::args::define {
        @id  -id ::argparsingtest::test1_punkargs2
        @cmd -name argtest4 -help "test of punk::args::get_dict comparative performance"
        @opts -anyopts 0
        -return     -default string -type string
        -frametype  -default \uFFEF -type string
        -show_edge  -default \uFFEF -type string
        -show_seps  -default \uFFEF -type string
        -join       -type none -multiple 1
        -x          -default "" -type string
        -y          -default b -type string
        -z          -default c -type string
        -1          -default 1 -type boolean
        -2          -default 2 -type integer
        -3          -default 3 -type integer
        @values
    } 
    proc test1_punkargs2 {args} {
        set argd [punk::args::get_by_id ::argparsingtest::test1_punkargs2 $args]
        return [tcl::dict::get $argd opts]
    }


    proc test1_punkargs_validate_ansistripped {args} {
        set argd [punk::args::get_dict {
            @id -id ::argparsingtest::test1_punkargs_validate_ansistripped
            @cmd -name argtest4 -help "test of punk::args::get_dict comparative performance"
            @opts -anyopts 0
            -return     -default string -type string -choices {string object} -help "return type"
            -frametype  -default \uFFEF -type string
            -show_edge  -default \uFFEF -type string
            -show_seps  -default \uFFEF -type string
            -join       -type none -multiple 1
            -x          -default "" -type string
            -y          -default b -type string
            -z          -default c -type string
            -1          -default 1 -type boolean -validate_ansistripped true
            -2          -default 2 -type integer -validate_ansistripped true
            -3          -default 3 -type integer -validate_ansistripped true
            @values
        } $args]
        return [tcl::dict::get $argd opts]
    }

    package require opt
    variable optlist
    tcl::OptProc test1_opt {
        {-return string "return type"}
        {-frametype \uFFEF "type of frame"}
        {-show_edge \uFFEF "show table outer borders"}
        {-show_seps \uFFEF "show separators"}
        {-join "solo option"}
        {-x "" "x val"}
        {-y b "y val"}
        {-z c "z val"}
        {-1 1 "1val"}
        {-2 -int 2  "2val"}
        {-3 -int 3 "3val"}
    } {
        set opts [dict create]
        foreach v [info locals] {
            dict set opts $v [set $v]
        }
        return $opts
    }

    package require cmdline
    #cmdline::getoptions is much faster than typedGetoptions
    proc test1_cmdline_untyped {args} {
        set cmdlineopts_untyped { 
            {return.arg   "string" "return val"} 
            {frametype.arg \uFFEF "frame type"}
            {show_edge.arg \uFFEF "show table borders"}
            {show_seps.arg \uFFEF "show table seps"} 
            {join        "join the things"}
            {x.arg  ""  "arg x"}
            {y.arg  b  "arg y"}
            {z.arg  c  "arg z"}
            {1.arg  1  "arg 1"}
            {2.arg  2  "arg 2"}
            {3.arg  3  "arg 3"}
        }

        set usage "usage etc"
        return [::cmdline::getoptions args $cmdlineopts_untyped $usage]
    }
    proc test1_cmdline_typed {args} {
        set cmdlineopts_typed { 
            {return.arg   "string" "return val"} 
            {frametype.arg \uFFEF "frame type"}
            {show_edge.arg \uFFEF "show table borders"}
            {show_seps.arg \uFFEF "show table seps"} 
            {join        "join the things"}
            {x.arg  ""  "arg x"}
            {y.arg  b  "arg y"}
            {z.arg  c  "arg z"}
            {1.boolean  1  "arg 1"}
            {2.integer  2  "arg 2"}
            {3.integer  3  "arg 3"}
        }

        set usage "usage etc"
        return [::cmdline::typedGetoptions args $cmdlineopts_typed $usage]
    }

    catch {
        package require argp
        argp::registerArgs test1_argp {
        {    -return      string  "string"    }
        {    -frametype   string  \uFFEF    }
        {    -show_edge   string  \uFFEF    }
        {    -show_seps   string  \uFFEF    }
        {    -x           string ""         }
        {    -y           string b         }
        {    -z           string  c         }
        {    -1           boolean 1         }
        {    -2           integer 2         }
        {    -3           integer 3         }
        }
    }
    proc test1_argp {args} {
        argp::parseArgs opts
        return [array get opts]
    }

    package require tepam
    tepam::procedure {test1_tepam} {
    -args {
        {-return    -type string -default string}
        {-frametype -type string -default \uFFEF}
        {-show_edge -type string -default \uFFEF}
        {-show_seps -type string -default \uFFEF}
        {-join      -type none -multiple}
        {-x         -type string -default ""}
        {-y         -type string -default b}
        {-z         -type string -default c}
        {-1         -type boolean -default 1}
        {-2         -type integer -default 2}
        {-3         -type integer -default 3}
    }
    } {
        return [dict create return $return frametype $frametype show_edge $show_edge show_seps $show_seps x $x y $y z $z 1 $1 2 $2 3 $3 join $join]
    }

    #multiline values use first line of each record to determine amount of indent to trim
    proc test_multiline {args} {
        set t3 [textblock::frame t3]
        set argd [punk::args::get_dict [subst {
            -template1 -default {
                ******
                * t1 *
                ******
            }
                -template2 -default {    ------
                    ******
                    * t2 *
                    ******}
            -template3 -default {$t3}
            #substituted or literal values with newlines - no autoindent applied - caller will have to pad appropriately 
            -template3b -default {
            $t3
            -----------------
            $t3
                   abc\ndef
            }
            -template4 -default "******
            * t4 *
            ******"
            -template5 -default "


            "
            -flag -default 0 -type boolean
        }] $args]
        return $argd
    }

    #proc sample1 {p1 n args} {
    #    #*** !doctools
    #    #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]]
    #    #[para]Description of sample1 
    #    #[para] Arguments:
    #    #   [list_begin arguments]
    #    #   [arg_def tring p1]       A description of string argument p1.
    #    #   [arg_def integer n]      A description of integer argument n.
    #    #   [list_end]
    #    return "ok" 
    #}




    #*** !doctools
    #[list_end] [comment {--- end definitions namespace argparsingtest ---}]
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++


# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Secondary API namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval argparsingtest::lib {
    namespace export {[a-z]*}  ;# Convention: export all lowercase
    namespace path [namespace parent]
    #*** !doctools
    #[subsection {Namespace argparsingtest::lib}]
    #[para] Secondary functions that are part of the API 
    #[list_begin definitions]

    #proc utility1 {p1 args} {
    #    #*** !doctools
    #    #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]]
    #    #[para]Description of utility1 
    #    return 1 
    #}



    #*** !doctools
    #[list_end] [comment {--- end definitions namespace argparsingtest::lib ---}]
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++



# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section Internal]
namespace eval argparsingtest::system {
    #*** !doctools
    #[subsection {Namespace argparsingtest::system}]
    #[para] Internal functions that are not part of the API 



}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
##  Ready   
package provide argparsingtest [namespace eval argparsingtest {
    variable pkg argparsingtest
    variable version
    set version 999999.0a1.0 
}]
return

#*** !doctools
#[manpage_end]