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 _mnames
        return $_mnames
      }
    }

    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 {
          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