package require Tcl 8.6
package require TclOO

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

  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::define [self] {
      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] {
          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 show {} {
            set result {}
            foreach v [info object variables [self]] {
              my variable $v
              lappend result -$v [set $v]
            }
            return $result
          }
        }
      }
    }

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


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

oo::objdefine record {
  method show {what {of ""}} {
    switch -- $what {
      record {
        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 record]
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]

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 name rollno address_id
-id -1 -name {} -rollno {} -address_id <null>
id name rollno address_id
-id -1 -name {configured name} -rollno {configured rollno} -address_id <null>
1
1

0

0