# Meta require {struct::queue 1}

# @@ Meta End

## - The config manages the argument values, and can parse
##   a command line against the definition, filling values,
##   issuing errors on mismatches, etc.

## TODO: Replace the direct ansi color references in state dumps with
##       "cmdr::color" and its symbolic names.

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require debug
package require debug::caller

    ## Lifecycle.

    forward context context

    # Make self accessible.
    method self {} { self }

    constructor {context spec {super {}}} {
	debug.cmdr/config {owner=([$context fullname])}

	classvariable ourinteractive
	if {![info exists ourinteractive]} { set ourinteractive 0 }

	classvariable ourdisplay
	if {[info exists ourdisplay]} {
	    set mydisplay $ourdisplay

	set mymap      {} ;# parameter name -> object
	set mypub      {} ;# parameter name -> object, non-state only, i.e. user visible
	set myoption   {} ;# option         -> object
	set myfullopt  {} ;# option prefix  -> list of full options having that prefix.
	set myargs     {} ;# List of argument names.
	set mysections {}
	set myinforce  no

	# Updated in Import and DefineParameter, called from the $spec
	set splat no

	# Import from the 'super', if specified. This is done before
	# the specification is run, as these have priority.
	if {$super ne {}} {
	    my Import $super
	}

	# Import the DSL commands.
	link \
	    {undocumented Undocumented} \
	    {description  Description} \
	    {use          Use} \
	    {input        Input} \
	    {interactive  Interactive} \
	    {option       Option} \
	    {state        State} \
	    {section      Section}

	if {$spec ne {}} {

	    debug.cmdr/config {==== eval spec begin ====}
	    # Auto inherit common options, state, arguments.
	    # May not be defined. Only done if the context
	    # has a specification (=> i.e. is private). For officers we start out empty.
	    try {
		use *all*
	    } trap {CMDR STORE UNKNOWN} {e o} {
		# Swallow possibility of a misisng *all*.
	    }
	    eval $spec
	    debug.cmdr/config {==== eval spec done =====}
	}


	# Postprocessing

	my complete-definitions

	set mypq [struct::queue P] ;# actual parameters
	if {[llength $myargs]} {
	    set myaq [struct::queue A] ;# formal argument parameters
	}
	return
    }

    method complete-definitions {} {
	debug.cmdr/config {}
	my SetThresholds
	my UniquePrefixes
	my CompletionGraph
	return
    }

    method help {{mode public}} {
	debug.cmdr/config {}
	# command   = dict ('desc'       -> description
	#                   'options'    -> options
	#                   'arguments'  -> arguments
	#                   'parameters' -> parameters)

	#
	# Option aliases are listed in options, but not in parameters.

	set options {}
	set optpara {}

	dict for {o para} $myoption {

	    # Ignore options imported from the parent.
	    # These are documented where defined.
	    if {[$para config] ne [self]} continue

	    # in interactive mode undocumented options can be shown in
	    # the help if they already have a value defined for them.
	    if {![$para documented] &&
		(($mode ne "interact") ||
		 ![$para set?])} continue

	    # in interactive mode we skip all the aliases.

	# not just bits and pieces.

	set states     {}
	set parameters {}

	foreach p [lsort -dict $mynames] {
	    set para [dict get $mymap $p]

	    # Ignore all parameters imported from the parent.
	    # These are documented where defined.
	    if {[$para config] ne [self]} continue

	    dict set parameters $p [$para help]

	    if {![$para is state]} continue
	    lappend states $p
	}

	return [dict create \

    }

    method Section {args} {
	# Remember the help section this private is a part of.
	lappend mysections $args
	return
    }

    # Externally visible variant of the 'Option' specification command.
    method make-option {args} {
	# Splat is a dummy for this.
	set splat no
	my DefineParameter 0 1 0 0 {*}$args
    }
    # Externally visible variant of the 'State' specification command.
    method make-state {args} {
	# Splat is a dummy for this.
	set splat no
	my DefineParameter 0 0 1 1 {*}$args
    }

    # Parameter definition itself.
    # order, cmdline, required, defered (O C R D) name ?spec?
    forward Input     my DefineParameter 1 1 1 0
    forward Option    my DefineParameter 0 1 0 0
    forward State     my DefineParameter 0 0 1 1
    # O+C+R specify the parameter type. D may vary.

	my ValidateAsUnknown $name

	# Create and initialize handler.
	set para [cmdr::parameter create param_$name [self] \
		      $order $cmdline $required $defered \
		      $name $desc $spec]

	my LinkPara $para
	return
    }

    method LinkPara {para} {
	debug.cmdr/config {}
	upvar 1 splat splat

	set name  [$para name]
	set order [$para ordered]

	# Map parameter name to handler object.
	dict set mymap $name $para

	# And a second map, user-visible parameters only,
	# i.e. available on the cmdline, and documented.
	if {[$para cmdline] && [$para documented]} {
	    dict set mypub $name $para

		dict set myoption $option $para
	    }
	}

	# And the list of all parameters in declaration order, for use
	# in 'force'.
	lappend mynames $name

	debug.cmdr/config {/done $name}
	return
    }

    method Import {other} {
	debug.cmdr/config {from [$other context fullname]}

	upvar 1 splat splat
	# Import the parameters from another config instance
	# into ourselves.

	# This is similar to DefineParameter, except that the
	# parameter instances are not created. They already exist and
	# simply have to be linked into the local data structures.

	foreach name [$other names] {
	    debug.cmdr/config {importing $name}
	    my LinkPara [$other lookup $name]
	}

	debug.cmdr/config {/done}
	return
    }

    method ValidateAsUnknown {name} {
	debug.cmdr/config {}
	if {![dict exists $mymap $name]} return

	debug.cmdr/config {DUP}
	return -code error -errorcode {CMDR CONFIG KNOWN} \
	    "Duplicate parameter \"[context fullname]: $name\", already specified."
    }

    # # ## ### ##### ######## #############
    ## Command completion. This is the entry point for recursion from
    ## the higher level officers, delegated to config from cmdr::private

	    return
	}
	P put {*}$arguments

	debug.cmdr/config {done}
	return
    }

    method parse-head-options {args} {
	debug.cmdr/config {}

	# - Reset the state values (we might be in an interactive shell, multiple commands).
	# - Stash the parameters into a queue for processing.
	# - Stash the (ordered) arguments into a second queue.
	# - Operate on parameter and arg queues until empty,
	#   dispatching the words to handlers as needed.

	if {![llength $args]} { return {} }

	my reset
	P clear
	P put {*}$args

	debug.cmdr/config {options only}
	while {[P size]} {
	    set word [P peek]
	    debug.cmdr/config {[P size] ? $word}
	    if {![string match -* $word]} break
	    my ProcessOption
	}
	# Non-option found, or end of words reached.
	# Return the remainder.
	set n [P size]
	if {!$n} {
	    return {}
	} elseif {$n == 1} {
	    return [list [P get]]
	} else {
	    return [P get $n]
	}
    }

    method parse {args} {
	debug.cmdr/config {}

	# - Reset the state values (we might be in an interactive shell, multiple commands).
	# - Stash the parameters into a queue for processing.
	# - Stash the (ordered) arguments into a second queue.

    method ProcessOption {} {
	debug.cmdr/config {}
	# Get option. Do special handling.
	# Non special option gets dispatched to handler (cmdr::parameter instance).
	# The handler is responsible for retrieved the option's value.
	set option [P get]
	debug.cmdr/config {taking ($option)}

	# Handle general special forms:
	#
	# --foo=bar ==> --foo bar
	# -f=bar    ==> -f bar

	if {[regexp {^(-[^=]+)=(.*)$} $option --> option value]} {
	    P unget $value
	}

	debug.cmdr/config {having ($option)}

	# Validate existence of the option
	if {![dict exists $myfullopt $option]} {
	    my raise "Unknown option $option" \
		CMDR CONFIG BAD OPTION
	}

    }

    # # ## ### ##### ######## #############
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::config 1.2

    return [join $lines \n]
}

# # ## ### ##### ######## ############# #####################
## Show help by category/ies

proc ::cmdr::help::format::by-category {root width help} {
    debug.cmdr/help {name ([$root name])}

    # I. Extract the category information from the help structure and
    #    generate the tree of categories with their commands.

    lassign [SectionTree $help [$root name]] subc cmds

    # II. Order the main categories. Allow for user influences.
    set categories [SectionOrder $root $subc]

    # III. Take the category tree and do the final formatting.
    set lines {}
    foreach c $categories {

    if {[dict size $options]} {
	return "\[OPTIONS\] "
    } else {
	return {}
    }
}

proc ::cmdr::help::format::SectionTree {help root {fmtname 1}} {

    array set opts {} ;# cmd -> option -> odesc
    array set subc {} ;# category path -> list (child category path)
    array set cmds {} ;# category path -> list (cmd)
    #                    cmd = tuple (label description)

    dict for {name def} $help {
	dict with def {} ; # -> desc, arguments, parameters, sections

	# Do not show the auto-generated commands in the categorized help.
	if {"*AutoGenerated*" in $sections} {
	    continue
	}

	# Exclude officers from the categorized help. They can only be
	# a source of shared options. Shared options are collected in
	# a separate structure.
	if {![info exists action] && [dict size $options]} {
	    set opts($name) $options
	    continue
	}


	if {![llength $sections]} {
	    lappend sections Miscellaneous
	}

	if {$fmtname} {
	    append name " " [Arguments $arguments $parameters]
	}
	set    desc [lindex [split $desc .] 0]
	set    cmd  [::list [string trim $name] $desc]

	foreach category $sections {
	    lappend cmds($category) $cmd
	    LinkParent $category
	}
    }

    # Options for the root => global options, put into the section tree.
    # We are ignoring deeper shared options.

    if {[info exists opts($root)]} {
	set options $opts($root)

	set category {Global Options}
	lappend sections $category
	set category [::list $category]
	foreach {o d} $options {
	    lappend cmds($category) [::list $o [string trim $d]]
	    LinkParent $category
	}

	unset opts($root)
    }

    # puts ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    # parray subc
    # parray cmds
    # parray opts
    # puts ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    ::list [array get subc] [array get cmds]
}

proc ::cmdr::help::format::LinkParent {category} {
    if {![llength $category]} return
    upvar 1 subc subc
    set parent [lreverse [lassign [lreverse $category] leaf]]
    lappend subc($parent) $leaf
    LinkParent $parent
    return
}

proc ::cmdr::help::format::SectionOrder {root subc} {
    # IIa. Natural order first.
    set categories [lsort -dict -unique [dict get $subc {}]]

    set generated {
	Miscellaneous
	{Global Options}
    }

    # IIb. Look for and apply user overrides.
    if {[$root exists *category-order*]} {
	# Record natural order
	set n 0
	foreach c $categories {
	    dict set map $c $n
	    incr n -10
	}
	# Special treatment of generated categories, move to end.
	set end -10000
	foreach $c generated {
	    if {$c ni $categories} continue
	    dict set map $c $end
	    incr end -10000
	}
	# Overwrite natural with custom ordering.
	dict for {c n} [$root get *category-order*] {
	    if {$c ni $categories} continue
	    dict set map $c $n
	}
	# Rewrite into tuples.
	foreach {c n} $map {
	    lappend tmp [::list $n $c]
	}

	#puts [join [lsort -decreasing -integer -index 0 $tmp] \n]

	# Sort tuples into chosen order, and rewrite back to list of
	# plain categories.
	set categories {}
	foreach item [lsort -decreasing -integer -index 0 $tmp] {
	    lappend categories [lindex $item 1]
	}
    } else {
	# Without a bespoke ordering only the generated categories are
	# treated specially.
	foreach c $generated {
	    set pos [lsearch -exact $categories $c]
	    if {$pos < 0} continue
	    set categories [linsert [lreplace $categories $pos $pos] end $c]
	}
    }

    return $categories
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::help 1.3

    set commands [json::write object {*}$dict]


    # Step 2. Section Tree. This is very similar to
    # cmdr::help::format::by-category, and re-uses its frontend helper
    # commands.

    lassign [SectionTree $help \000 0] subc cmds
    foreach c [SectionOrder $root $subc] {
	lappend sections [JSON::acategory [::list $c] $cmds $subc]
    }

    return [json::write object \
		sections [json::write array {*}$sections] \
		commands $commands]

    # Data structure: see config.tcl,  method 'help'.
    # Data structure: see private.tcl, method 'help'.

    dict with command {}
    # -> action, desc, options, arguments, parameters, states, sections

    lappend dict description [JSON::astring    $desc]
    if {[info exists action]} {
	# Missing for officers.
	lappend dict action [JSON::alist $action]
    }
    lappend dict arguments   [JSON::alist      $arguments]
    lappend dict options     [JSON::adict      $options]
    lappend dict opt2para    [JSON::adict      $opt2para]
    lappend dict states      [JSON::alist      $states]
    lappend dict parameters  [JSON::parameters $parameters]
    lappend dict sections    [JSON::alist      $sections]
    

proc ::cmdr::help::format::JSON::astring {string} {
    regsub -all -- {[ \n\t]+} $string { } string
    return [json::write string [string trim $string]]
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::help::json 1.1

    upvar 1 states     xstates
    upvar 1 flags      xflags

    # ---

    dict with command {} ; # -> action, desc, options, arguments, parameters, states

    if {[info exists action]} {
	set action [SQL::astring $action]
    } {
	set action NULL
    }
    set cid [SQL::++ commands cno \
		 [SQL::astring $name] \
		 [SQL::astring $desc] \
		 $action]

    set sequence 0
    foreach {pname param} $parameters {
	set pid [SQL::++ parameters pno [SQL::astring $pname] \
		     $cid $sequence \
		     {*}[SQL::para $param]]

	       pid  INTEGER REFERENCES parameters
       );
	CREATE INDEX fname on flags ( name );
    }
}
# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::help::sql 1.1

	lappend commands $cmd [TCL $desc]
    }

    # Step 2. Section Tree. This is very similar to
    # cmdr::help::format::by-category, and re-uses its frontend helper
    # commands.

    lassign [SectionTree $help \000 0] subc cmds
    foreach c [SectionOrder $root $subc] {
	lappend sections [TCL::acategory [::list $c] $cmds $subc]
    }

    return [dict create \
		commands $commands \
		sections $sections]

proc ::cmdr::help::format::TCL {command} {
    # Data structure: see config.tcl,  method 'help'.
    # Data structure: see private.tcl, method 'help'.

    dict with command {}
    # -> action, desc, options, arguments, parameters, states, sections

    if {[info exists action]} {
	# Missing for officers.
	lappend dict action $action
    }
    lappend dict arguments   $arguments
    lappend dict description [TCL::astring $desc]
    lappend dict opt2para    [::cmdr util dictsort $opt2para]
    lappend dict options     [::cmdr util dictsort $options]
    lappend dict parameters  [TCL::parameters $parameters]
    lappend dict sections    $sections
    lappend dict states      $states

proc ::cmdr::help::format::TCL::astring {string} {
    regsub -all -- {[ \n\t]+} $string { } string
    return [string trim $string]
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::help::tcl 1.1

# Meta require cmdr::private
# Meta require debug
# Meta require debug::caller
# Meta require linenoise::facade
# Meta require try
# Meta require {Tcl 8.5-}
# Meta require {oo::util 1.2}
# Meta require {string::token::shell 1.2}
# @@ Meta End

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require debug
package require debug::caller
package require linenoise::facade
package require string::token::shell 1.2
package require try
package require TclOO
package require oo::util 1.2 ;# link helper.
package require cmdr::actor
package require cmdr::private
package require cmdr::help
package require cmdr::config

# # ## ### ##### ######## ############# #####################

debug define cmdr/officer
debug level  cmdr/officer
debug prefix cmdr/officer {[debug caller] | }

	set mypmap      {}       ; # Ditto for the map of action abbreviations.
	set mycommands  {}       ; # Ditto
	set myccommands {}       ; # Ditto, derived cache, see method CCommands.
	set mychildren  {}       ; # List of created subordinates.
	set myhandler   {}       ; # Handler around cmd parsing and execution.
	set myshandler  {}       ; # Setup handler, run after regular object
	#                          # initialization from its definition.
	set myconfig    {}
	return
    }

    # # ## ### ##### ######## #############

    method ehandler {cmd} {
	debug.cmdr/officer {}

    }

    method children {} {
	debug.cmdr/officer {}
	my Setup
	return $mychildren
    }

    # Make the parameter container accessible.
    method config {} {
	debug.cmdr/officer {}
	return $myconfig
    }

    # # ## ### ##### ######## #############
    ## Internal. Dispatcher setup. Defered until required.
    ## Core setup code runs only once.

    method Setup {} {
	# Process the action specification only once.
	if {$myinit} return
	set myinit 1
	debug.cmdr/officer {}

	set super [my super]
	if {$super ne {}} {
	    set super [$super config]
	}

	set myconfig [cmdr::config create config [self] {} $super]
	my learn $myactions
	$myconfig complete-definitions

	# Auto-create a 'help' command when possible, i.e not in
	# conflict with a user-specified command.
	if {![my has help]} {
	    cmdr help auto [self]
	}

	    {shandler    shandler} \
	    {private     Private} \
	    {officer     Officer} \
	    {default     Default} \
	    {alias       Alias} \
	    {description description:} \
	    undocumented \
	    {common      set} \
	    {option      Option} \
	    {state       State}
	eval $script

	# Postprocessing.
	set mycommands [lsort -dict $mycommands]
	return
    }

	}

	[my lookup $cmd] extend $path $arguments $action
    }

    # # ## ### ##### ######## #############
    ## Implementation of the action specification language.

    forward Option  config make-option
    forward State   config make-state

    # common      => set          (super cmdr::actor)
    # description => description: (super cmdr::actor)

    forward Private my DefineAction private
    forward Officer my DefineAction officer

	set reset 0
	if {![my exists *command*]} {
	    # Prevent handling of application-specific options here.
	    my set *command* -- $args
	    set reset 1
	}
	try {
	    # Process any options we may find. The first non-option
	    # will be the command to dispatch on.
	    set arg [config parse-head-options {*}$args]

	    # Empty command. Delegate to the default, if we have any.
	    # Otherwise fail.
	    if {![llength $args]} {
		if {[my hasdefault]} {
		    return [[my lookup [my default]] do]
		}
		return -code error -errorcode {CMDR DO EMPTY} \

	if {$cmd eq ".exit"} {
	    # See method 'shell-exit' as well, and 'Setup' for
	    # the auto-creation of an 'exit' command when possible,
	    # i.e not in conflict with a user-specified command.
	    set myreplexit 1 ; return
	}
	my Do {*}[string token shell -- $cmd]
    }

    method report {what data} {
	debug.cmdr/officer {}
	switch -exact -- $what {
	    ok {
		if {$data eq {}} return

	set help {}
	foreach c [my known] {
	    set cname [list {*}$prefix $c]
	    set actor [my lookup $c]
	    if {![$actor documented]} continue
	    set help [dict merge $help [$actor help $cname]]
	}

	# Add the officer itself, to provide its shared options.
	dict set help $prefix [config help]

	return $help
    }

    # # ## ### ##### ######## #############

    variable myinit myactions mymap mycommands myccommands mychildren \
	myreplexit myhandler mypmap myshandler myconfig

    # # ## ### ##### ######## #############
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::officer 1.4

    method Setup {} {
	# Process myarguments only once.
	if {$myinit} return
	debug.cmdr/private {}
	set myinit 1

	# Create and fill the parameter collection.
	set myconfig [cmdr::config create config [self] \
			  $myarguments \
			  [[my super] config]]
	return
    }

    # # ## ### ##### ######## #############

    method FullCmd {cmd} {
	# See also officer::Do

    variable myarguments mycmd myinit myconfig myhandler

    # # ## ### ##### ######## #############
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::private 1.3