Artifact f732de89bc2ee92f0674fbe8778ebb191519765d:

• Executable file packages/eav/lib/entity.tcl — part of check-in [5451b62bf9] at 2019-10-04 07:15:54 on branch trunk — eav reorganize test suite code

  puts [list zorg [::tcl::unsupported::representation $vlurb]]

  failing test

  type_settext_findint

  eav entity

  tests are currently failing

  (user: pooryorick size: 2769)

#! /bin/env tclsh

variable doc {
	description {
		A {ycl shelf} providing a convenient interface to the {ycl eav} system
		from the viewpoint of a particular entity in the system . It exposes
		all the {ycl eav} interface commands , but with a more concise syntax
		for comands since it can substitute the entity it represents into the
		command . Where it doesn't make sense to shorten the command syntax
		because knowing the entity provides no value , this shelf is just a
		synonym for the {ycl eav} it represents .

		One additional command , [eav] , is added to the shelf , to directly
		call the eav it represents .
	}
}

.my .routine eav eav

variable doc::init {
	args {
		_ {
			description {
				A {ycl shelf} co configure as an entity 
			}
		}
		entity {
			description {
				The entity to represent
			}
			process {$_ $ entity $entity}
		}
		eav {
			description {
				The command to access an eav.
			}
			process {$_ $ eav $eav}
		}
	}
}
proc entity {_ args} {
	$_ $ entity
}
.my .method entity

proc list_ {_ report args} {
	namespace upvar $_ eav eav entity entity
	set results [{*}$eav list $report entity == $entity {*}$args]
	return [dict values $results]
}
.my .method list list_ 

proc init {_ args} {
	checkargs [set doc::[namespace tail [lindex [info level 0] 0]]] {*}$args

	foreach name {
			ddestroy
			exists
			get
			id
			incr
			insert
			set
			trace
			unset
	} {
		$_ .method $name [list ::apply [list {_ args} [string map [
			list @name@ [list $name]] {
			namespace upvar $_ eav eav entity entity 
			::tailcall {*}$eav @name@ $entity {*}$args
		}]]]
	}

	foreach name {
		ensure
		entities
		find
		findm
		gen
		redpill
		revision
		the
		or
	} {
		$_ .method $name [list ::apply [list {_ args} [string map [
			list @name@ [list $name]] {
			namespace upvar $_ eav eav
			::tailcall {*}$eav @name@ {*}$args 
		}]]]
	}

	foreach name {
		dexists
		dget 
		dset
		dunset
	} {
		$_ .method $name [list ::apply [list {_ path args} [string map [
			list @name@ [list $name]] {
			namespace upvar $_ eav eav entity entity 
			::tailcall {*}$eav @name@ $entity {*}$path {*}$args
		}]]]
	}


	$_ .method db [list ::apply {{_ args} {
		namespace upvar $_ eav eav 
		::tailcall {*}$eav db {*}$args
	}}]

	$_ .method trace [list ::apply {{_ args} {
		namespace upvar $_ eav eav entity entity 
		::tailcall {*}$eav trace [lindex $args 0] $entity {*}[
			lrange $args 1 end]
	}}]

	$_ .method array [list ::apply {{_ cmd args} {
		namespace upvar $_ eav eav entity entity 
		# Warning, this makes all array subcommands available, but is only
		# compatible with those that take an entity as the first argument .  Do
		# not use the other commands .
		::tailcall {*}$eav array $cmd $entity {*}$args
		
	}}]

	return $_
}
.my .method init