package require Tcl 8.6
package require TclOO

oo::class create recordInst {
        constructor {mnames ivals args} {
                oo::objdefine [self] [list variable {*}$mnames]
                foreach n $mnames {
                        my variable $n
                        set $n [dict get $ivals $n]
                }

                foreach {opt v} $args {
                        set n [string range $opt 1 end]
                        set $n $v
                }

                oo::objdefine [self] [list variable _ivals]
                my variable _ivals
                set _ivals $ivals
        }

        method cget {args} {
                switch -- [llength $args] {
                        1 { 
                                set n [string range $args 1 end]
                                my variable $n
                                return $n
                        }
                        0 {
                                return [my show]
                        }
                        default {
                                foreach o $args {
                                        set n [string range $o 1 end]
                                        my variable $n
                                        lappend result [set $n]
                                }
                        }
                }
        }

        method configure {args} {
                if {$args != ""} {
                        foreach {opt val} $args {
                                set n [string range $opt 1 end]
                                my variable $n
                                set $n $val
                        }
                } else {
                        return [my show]
                }
        }

        method clear {} {
                my variable _ivals                                                
                dict for {n val} $_ivals {
                        my variable $n
                        set $n $val
                }
        }

        method show {} {
                my variable _ivals                                                
                set result {}
                foreach n [dict keys $_ivals] {
                        my variable $n
                        lappend result -$n [set $n]
                }
                return $result
        }
}

oo::class create recordType {
        constructor {recorddefn args} {
                oo::objdefine [self] variable _recorddefn _mnames _ivals
                my variable _recorddefn
                my variable _mnames
                my variable _ivals

                set _recorddefn $recorddefn

                set mnames [list]
                set ivals [dict create]
                foreach member $recorddefn {
                        lassign $member n v
                        lappend mnames $n
                        switch -- [llength $member] {
                                1 {
                                        dict set ivals $n <undefined>
                                }
                                2 {
                                        dict set ivals $n $v
                                }
                                default {
                                        return -code error "Unsupported nested definition $f found in [self]."
                                }
                        }
                }

                set _mnames $mnames
                set _ivals $ivals

                set create_method {
                        method create {name args} {
                                next $name ${mnames} ${ivals} {*}$args
                        }
                }
                set create_method [string map [list \${mnames} [list $mnames] \${ivals} [list $ivals]] $create_method]
                oo::objdefine [self] $create_method

                oo::objdefine [self] {
                        method show {} {
                                my variable _recorddefn
                                return $_recorddefn
                        }
                }

                oo::define [self] {
                        mixin recordInst
                }

                foreach inst $args {
                        uplevel 1 [list [self] create $inst]
                }
        }
}

oo::class create record {
        superclass oo::class

        mixin recordType

        self {

                method show {what {of ""}} {
                        switch -- $what {
                                record - records {
                                        return [uplevel 1 [list info class instances [self]]]
                                }
                                instances {
                                        set ns [uplevel 1 [list namespace which $of]]
                                        return [uplevel 1 [list info class instances $ns]]
                                }
                                members {
                                        set ns [uplevel 1 [list namespace which $of]]
                                        return [uplevel 1 [list $of show]]
                                }
                                values {
                                        set ns [uplevel 1 [list namespace which $of]]
                                        return [uplevel 1 [list $of show]]
                                }
                        }
                }

                method exists {what obj {type ""}} {
                        set nsobj [uplevel 1 [list namespace which $obj]]
                        if {$nsobj == ""} {
                                return 0
                        }
                        if {$what == "instance"} {
                                if {$type == ""} {
                                        return -code error "missing value for argument: type"
                                }
                                set nstype [uplevel 1 [list namespace which $type]]
                                return [uplevel 1 [list info object isa typeof $nsobj $nstype]]
                        } else {
                                return [uplevel 1 [list info object isa typeof $nsobj [self]]]
                        }
                }

                method delete {what obj {type ""}} {
                        set nsobj [uplevel 1 [list namespace which $obj]]
                        return [uplevel 1 [list $nsobj destroy]]
                }
        }
}

package provide Record 0.1

package require Record 0.1

record create Employee {
        {id -1}
        {name ""}
        {rollno ""}
        {address_id <null>}
} emp1 emp2

puts [record show records]
puts [record show instances Employee]
puts [record show members Employee]
puts [record show values emp1]


puts [Employee show]

emp2 configure -name "configured name" -rollno "configured rollno"
puts [emp2 cget]

emp2 clear
puts [emp2 cget]

puts [record exists record Employee]
puts [record exists instance emp1 Employee]
puts [record delete instance emp1]
puts [record exists instance emp1 Employee]
puts [record delete record Employee]
puts [record exists record Employee]

::Employee
::emp1 ::emp2

        {id -1}
        {name ""}
        {rollno ""}
        {address_id <null>}

-id -1 -name {} -rollno {} -address_id <null>

        {id -1}
        {name ""}
        {rollno ""}
        {address_id <null>}

-id -1 -name {configured name} -rollno {configured rollno} -address_id <null>
-id -1 -name {} -rollno {} -address_id <null>
1
1

0

0