## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Validate - Definition of core validation classes.

# @@ Meta Begin
# Package cmdr::validate 0
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary     Standard validation types for parameters.
# Meta description Standard validation types for parameters.
# Meta subject {command line}
# Meta require {Tcl 8.5-}
# Meta require {cmdr::validate::common 1.2}
# Meta require debug
# Meta require debug::caller
# @@ Meta End

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

package require Tcl 8.5
package require cmdr::validate::common 1.2
package require debug
package require debug::caller

# # ## ### ##### ######## ############# #####################
## Definition

namespace eval ::cmdr {
    namespace export validate
    namespace ensemble create
}

namespace eval ::cmdr::validate {
    namespace export boolean integer double percent identity \
	pass str rfile wfile rwfile rdirectory rwdirectory \
	rpath rwpath rchan wchan rwchan
    #namespace ensemble create

    # For external v-types relying on them here.
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-enum
}

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

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

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

namespace eval ::cmdr::validate::boolean {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-enum
}

proc ::cmdr::validate::boolean::release  {p x} { return }
proc ::cmdr::validate::boolean::default  {p}  {
    debug.cmdr/validate {}
    return no
}

proc ::cmdr::validate::boolean::complete {p x} {
    debug.cmdr/validate {} 10
    return [complete-enum {yes no false true on off 0 1} 1 $x]
}

proc ::cmdr::validate::boolean::validate {p x} {
    debug.cmdr/validate {}
    if {[string is boolean -strict $x]} {
	# Double inverse keeps value, and makes it canonical.
	return [expr {!!$x}]
    }
    fail $p BOOLEAN "a boolean (yes, no, false, true, on, off, 0, or 1)" $x
}

# # ## ### ##### ######## ############# #####################
## Any integer

namespace eval ::cmdr::validate::integer {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
}

proc ::cmdr::validate::integer::release  {p x} { return }
proc ::cmdr::validate::integer::default  {p}  {
    debug.cmdr/validate {}
    return 0
}
proc ::cmdr::validate::integer::complete {p x} {
    debug.cmdr/validate {} 10
    return {}
}
proc ::cmdr::validate::integer::validate {p x} {
    debug.cmdr/validate {}

    # While we accept integers in octal and hex we convert them into
    # proper decimals for internal use, as our standard
    # representation.
    if {[string is integer -strict $x]} {
	return [format %d $x]
    }
    fail $p INTEGER "an integer" $x
}

# # ## ### ##### ######## ############# #####################
## Any double

namespace eval ::cmdr::validate::double {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
}

proc ::cmdr::validate::double::release  {p x} { return }
proc ::cmdr::validate::double::default  {p}  {
    debug.cmdr/validate {}
    return 0
}
proc ::cmdr::validate::double::complete {p x} {
    debug.cmdr/validate {} 10
    return {}
}
proc ::cmdr::validate::double::validate {p x} {
    debug.cmdr/validate {}
    if {[string is double -strict $x]} { return $x }
    fail $p DOUBLE "a double" $x
}

# # ## ### ##### ######## ############# #####################
## Any double in [0,100]

namespace eval ::cmdr::validate::percent {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
}

proc ::cmdr::validate::percent::release  {p x} { return }
proc ::cmdr::validate::percent::default  {p}  {
    debug.cmdr/validate {}
    return 0
}
proc ::cmdr::validate::percent::complete {p x} {
    debug.cmdr/validate {} 10
    return {}
}
proc ::cmdr::validate::percent::validate {p x} {
    debug.cmdr/validate {}
    if {[string is double -strict $x] &&
	($x >= 0) &&
	($x <= 100)} { return $x }
    fail $p PERCENT "a percentage (\[0...100\])" $x
}

# # ## ### ##### ######## ############# #####################
## Any string

namespace eval ::cmdr::validate::identity {
    namespace export default validate complete release
    namespace ensemble create
}

proc ::cmdr::validate::identity::release  {p x} { return }
proc ::cmdr::validate::identity::default  {p}   { debug.cmdr/validate {}    ; return {} }
proc ::cmdr::validate::identity::complete {p x} { debug.cmdr/validate {} 10 ; return {} }
proc ::cmdr::validate::identity::validate {p x} { debug.cmdr/validate {}    ; return $x }

# # ## ### ##### ######## ############# #####################
## Any string, alternate name

namespace eval ::cmdr::validate::pass {
    namespace export default validate complete release
    namespace ensemble create
}

proc ::cmdr::validate::pass::release  {p x} { return }
proc ::cmdr::validate::pass::default  {p}   {debug.cmdr/validate {}    ; return {} }
proc ::cmdr::validate::pass::complete {p x} {debug.cmdr/validate {} 10 ; return {} }
proc ::cmdr::validate::pass::validate {p x} {debug.cmdr/validate {}    ; return $x }

# # ## ### ##### ######## ############# #####################
## Any string, alternate name, the second

namespace eval ::cmdr::validate::str {
    namespace export default validate complete release
    namespace ensemble create
}

proc ::cmdr::validate::str::release  {p x} { return }
proc ::cmdr::validate::str::default  {p}   { debug.cmdr/validate {}    ; return {} }
proc ::cmdr::validate::str::complete {p x} { debug.cmdr/validate {} 10 ; return {} }
proc ::cmdr::validate::str::validate {p x} { debug.cmdr/validate {}    ; return $x }

# # ## ### ##### ######## ############# #####################
## File, existing and readable

namespace eval ::cmdr::validate::rfile {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
}

proc ::cmdr::validate::rfile::release  {p x} { return }
proc ::cmdr::validate::rfile::default  {p}   { return {} }
proc ::cmdr::validate::rfile::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::rfile::Ok $x
}
proc ::cmdr::validate::rfile::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p RFILE "an existing readable file" $x
}

proc ::cmdr::validate::rfile::Ok {path} {
    if {![file exists   $path]} {return 0}
    if {![file isfile   $path]} {return 0}
    if {![file readable $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## File, existing and writable

namespace eval ::cmdr::validate::wfile {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
    namespace import ::cmdr::validate::common::ok-directory
}

proc ::cmdr::validate::wfile::release  {p x} { return }
proc ::cmdr::validate::wfile::default  {p}   { return {} }
proc ::cmdr::validate::wfile::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::wfile::Ok $x
}
proc ::cmdr::validate::wfile::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p WFILE "a writable file" $x
}

proc ::cmdr::validate::wfile::Ok {path} {
    if {![file exists $path]} {
	# The file is allowed to not exist if its directory exists and
	# is writable. This can apply recursively up the chain of
	# directories.
	return [ok-directory [file dirname $path]]
    }
    if {![file isfile   $path]} {return 0}
    if {![file writable $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## File, existing and read/writable

namespace eval ::cmdr::validate::rwfile {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
    namespace import ::cmdr::validate::common::ok-directory
}

proc ::cmdr::validate::rwfile::release  {p x} { return }
proc ::cmdr::validate::rwfile::default  {p}   { return {} }
proc ::cmdr::validate::rwfile::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::rwfile::Ok $x
}
proc ::cmdr::validate::rwfile::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p RWFILE "a read/writable file" $x
}

proc ::cmdr::validate::rwfile::Ok {path} {
    if {![file exists $path]} {
	# The file is allowed to not exist if its directory exists and
	# is writable. This can apply recursively up the chain of
	# directories.
	return [ok-directory [file dirname $path]]
    }
    if {![file isfile   $path]} {return 0}
    if {![file readable $path]} {return 0}
    if {![file writable $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Directory, existing and readable.

namespace eval ::cmdr::validate::rdirectory {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
}

proc ::cmdr::validate::rdirectory::release  {p x} { return }
proc ::cmdr::validate::rdirectory::default  {p}   { return {} }
proc ::cmdr::validate::rdirectory::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::rdirectory::Ok $x
}

proc ::cmdr::validate::rdirectory::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p RDIRECTORY "an existing readable directory" $x
}

proc ::cmdr::validate::rdirectory::Ok {path} {
    if {![file exists      $path]} {return 0}
    if {![file isdirectory $path]} {return 0}
    if {![file readable    $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Directory, existing and read/writable.

namespace eval ::cmdr::validate::rwdirectory {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
    namespace import ::cmdr::validate::common::ok-directory
}

proc ::cmdr::validate::rwdirectory::release  {p x} { return }
proc ::cmdr::validate::rwdirectory::default  {p}   { return {} }
proc ::cmdr::validate::rwdirectory::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::rwdirectory::Ok $x
}

proc ::cmdr::validate::rwdirectory::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p RWDIRECTORY "an existing read/writeable directory" $x
}

proc ::cmdr::validate::rwdirectory::Ok {path} {
    if {![file exists $path]} {
	# The directory is allowed to not exist if its parent
	# directory exists and is writable. This can apply recursively
	# up the chain of directories.
	return [ok-directory [file dirname $path]]
    }
    if {![file isdirectory $path]} {return 0}
    if {![file readable    $path]} {return 0}
    if {![file writable    $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Any path, existing and readable.

namespace eval ::cmdr::validate::rpath {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
}

proc ::cmdr::validate::rpath::release  {p x} { return }
proc ::cmdr::validate::rpath::default  {p}   { return {} }
proc ::cmdr::validate::rpath::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::rpath::Ok $x
}

proc ::cmdr::validate::rpath::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p RPATH "an existing readable path" $x
}

proc ::cmdr::validate::rpath::Ok {path} {
    if {![file exists   $path]} {return 0}
    if {![file readable $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Any path, existing and read/writable.

namespace eval ::cmdr::validate::rwpath {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
    namespace import ::cmdr::validate::common::ok-directory
}

proc ::cmdr::validate::rwpath::release  {p x} { return }
proc ::cmdr::validate::rwpath::default  {p}   { return {} }
proc ::cmdr::validate::rwpath::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::rwpath::Ok $x
}

proc ::cmdr::validate::rwpath::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p RWPATH "an existing read/writeable path" $x
}

proc ::cmdr::validate::rwpath::Ok {path} {
    if {![file exists $path]} {
	# The path is allowed to not exist if its directory exists and
	# is writable. This can apply recursively up the chain of
	# directories.
	return [ok-directory [file dirname $path]]
    }
    if {![file readable    $path]} {return 0}
    if {![file writable    $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Channel, for existing and readable file. Defaults to stdin.

namespace eval ::cmdr::validate::rchan {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
}

proc ::cmdr::validate::rchan::release  {p x} {
    if {$x eq "stdin"} return
    close $x
    return
}
proc ::cmdr::validate::rchan::default  {p}   { return stdin }
proc ::cmdr::validate::rchan::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::rchan::Ok $x
}
proc ::cmdr::validate::rchan::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return [open $x r] }
    fail $p RCHAN "an existing readable file" $x
}

proc ::cmdr::validate::rchan::Ok {path} {
    if {![file exists   $path]} {return 0}
    if {![file isfile   $path]} {return 0}
    if {![file readable $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Channel, for existing and writable file. Defaults to stdout.

namespace eval ::cmdr::validate::wchan {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
    namespace import ::cmdr::validate::common::ok-directory
}

proc ::cmdr::validate::wchan::release  {p x} {
    if {$x eq "stdout"} return
    close $x
    return
}
proc ::cmdr::validate::wchan::default  {p}   { return stdout }
proc ::cmdr::validate::wchan::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::wchan::Ok $x
}
proc ::cmdr::validate::wchan::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return [open $x w] }
    fail $p WCHAN "a writable file" $x
}

proc ::cmdr::validate::wchan::Ok {path} {
    if {![file exists $path]} {
	# The file is allowed to not exist if its directory exists and
	# is writable. This can apply recursively up the chain of
	# directories.
	return [ok-directory [file dirname $path]]
    }
    if {![file isfile   $path]} {return 0}
    if {![file writable $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Channel, for existing and read/writable file. No default.

namespace eval ::cmdr::validate::rwchan {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
    namespace import ::cmdr::validate::common::ok-directory
}

proc ::cmdr::validate::rwchan::release  {p x} { close $x }
proc ::cmdr::validate::rwchan::default  {p}   { return {} }
proc ::cmdr::validate::rwchan::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::rwchan::Ok $x
}
proc ::cmdr::validate::rwchan::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return [open $x w+] }
    fail $p RWCHAN "a read/writable file" $x
}

proc ::cmdr::validate::rwchan::Ok {path} {
    if {![file exists   $path]} {
	# The file is allowed to not exist if its directory exists and
	# is writable. This can apply recursively up the chain of
	# directories.
	return [ok-directory [file dirname $path]]
    }
    if {![file isfile   $path]} {return 0}
    if {![file readable $path]} {return 0}
    if {![file writable $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::validate 1.3.2
return
