# ACTIVESTATE TEAPOT-PKG BEGIN TM -*- tcl -*-
# -- Tcl Module

# @@ Meta Begin
# Package mecate 1.2.1
# Meta description Mecate is a package that provides a set of command to
# Meta description interact with bosal generated test harnesses.
# Meta platform    tcl
# Meta require     {Tcl 8.6}
# Meta require     logger
# Meta require     oo::util
# Meta require     ral
# Meta require     ralutil
# Meta require     struct::queue
# Meta summary     Command interface to bosal generated test harnesses.
# @@ Meta End


# ACTIVESTATE TEAPOT-PKG BEGIN REQUIREMENTS

package require Tcl 8.6
package require logger
package require oo::util
package require ral
package require ralutil
package require struct::queue

# ACTIVESTATE TEAPOT-PKG END REQUIREMENTS

# ACTIVESTATE TEAPOT-PKG BEGIN DECLARE

package provide mecate 1.2.1

# ACTIVESTATE TEAPOT-PKG END DECLARE
# ACTIVESTATE TEAPOT-PKG END TM
# DO NOT EDIT THIS FILE!
# THIS FILE IS AUTOMATICALLY GENERATED FROM A LITERATE PROGRAM SOURCE FILE.
#
# This software is copyrighted 2018 by G. Andrew Mangogna.
# The following terms apply to all files associated with the software unless
# explicitly disclaimed in individual files.
# 
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors and
# need not follow the licensing terms described here, provided that the
# new terms are clearly indicated on the first page of each file where
# they apply.
# 
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING
# OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES
# THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
# 
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS,
# OR MODIFICATIONS.
# 
# GOVERNMENT USE: If you are acquiring this software on behalf of the
# U.S. government, the Government shall have only "Restricted Rights"
# in the software and related documentation as defined in the Federal
# Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
# are acquiring the software on behalf of the Department of Defense,
# the software shall be classified as "Commercial Computer Software"
# and the Government shall have only "Restricted Rights" as defined in
# Clause 252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing,
# the authors grant the U.S. Government and others acting in its behalf
# permission to use and distribute the software in accordance with the
# terms specified in this license.
#

package require Tcl 8.6
package require logger
package require logger::utils
package require logger::appender
package require ral
package require ralutil
package require oo::util
package require struct::queue

namespace eval ::mecate {
    namespace export rein
    namespace export eventTraceFormat
    namespace export instrTraceFormat
    namespace export fatalTraceFormat
    namespace ensemble create

    set logger [::logger::init mecate]
    set appenderType [expr {[dict exist [fconfigure stdout] -mode] ?\
            "colorConsole" : "console"}]
    ::logger::utils::applyAppender -appender $appenderType -serviceCmd $logger\
            -appenderArgs {-conversionPattern {\[%c\] \[%p\] '%m'}}
    ::logger::import -all -force -namespace log mecate

    variable version 1.2.1
}

::oo::class create ::mecate::rein {
    constructor {args} {
        ::logger::import -all -namespace log mecate
    
        set timeout 2000
        foreach {option value} $args {
            switch -exact -- $option {
                -timeout {
                    set timeout $value
                }
                default {
                    my Throw "unknown option, \"$option\""
                }
            }
        }
    
        log::debug "-timeout option = \"$timeout\""
    
        my variable tracesReceived
        set tracesReceived [::struct::queue]
    
        my variable instrReceived
        set instrReceived [::struct::queue]
    
        my variable fatalReceived
        set fatalReceived [::struct::queue]
    
        my variable tracePrefix
        set tracePrefix {}
        my variable instrPrefix
        set instrPrefix {}
        my variable fatalPrefix
        set fatalPrefix {}
    
        my variable seqDiagConfig
        set seqDiagConfig [dict create\
            -showstates false\
            -participants {}\
        ]
    
        namespace import ::ral::*
        namespace import ::ralutil::*
    
        relvar create Trace {
            TraceId     int
            Time        string
            Event       string
            Source      string
            Target      string
        } TraceId
        
        relvar create TransitionTrace {
            TraceId     int
            Current     string
            New         string
        } TraceId
        
        relvar create PolymorphicTrace {
            TraceId         int
            Relationship    string
            NewEvent        string
            Subclass        string
        } TraceId
        
        relvar create CreationTrace {
            TraceId         int
        } TraceId
        
        relvar partition R1 Trace TraceId\
            TransitionTrace TraceId\
            PolymorphicTrace TraceId\
            CreationTrace TraceId
        relvar create Instrumentation {
            TraceId     int
            Time        string
            Message     string
        } TraceId
        relvar create Fatal {
            TraceId     int
            Time        string
            Message     string
        } TraceId
    
        return
    }
    variable timeout connection
    destructor {
        my disconnect
    
        my variable tracesReceived
        $tracesReceived destroy
    
        my variable instrReceived
        $instrReceived destroy
    
        my variable fatalReceived
        $fatalReceived destroy
    
        relvar constraint delete R1
        relvar unset Trace TransitionTrace PolymorphicTrace CreationTrace\
                Instrumentation Fatal
    }
    method cget {option} {
        switch -exact -- $option {
            -timeout {
                return [set [string range $option 1 end]]
            }
    
            default {
                my Throw "unknown option, \"$option\""
            }
        }
    }
    method configure {args} {
        foreach {option value} $args {
            switch -exact -- $option {
                -timeout {
                    set [string range $option 1 end] $value
                }
    
                default {
                    my Throw "unknown option, \"$option\""
                }
            }
        }
    
        return
    }
    method start {program {delay 500}} {
        log::info "starting harness program, \"$program\""
        set progargs [auto_execok $program]
        if {$progargs eq {}} {
            my Throw "unknown program, \"$program\""
        }
        set pid [exec -ignorestderr -- $progargs &]
        after $delay
        return $pid
    }
    method connect {{port 3906}} {
        log::info "connecting to localhost:$port"
    
        set tries 0                                                             ; # <1>
        while {true} {
            try {
                set connection [socket localhost $port]
                chan configure $connection -blocking true -buffering line
                chan event $connection readable [mymethod HandleHarnessInput]   ; # <2>
                return
            } on error {result opts} {
                incr tries
                if {$tries >= 3} {
                    log::error "connection failure after $tries attempts"
                    return -options $opts $result
                }
                log::notice "connection attempt failed, waiting 500 ms to try again"
                after 500
            }
        }
    }
    method disconnect {} {
        log::info "disconnecting from test harness"
        if {[info exists connection]} {
            catch {chan close $connection}
            unset -nocomplain connection
        }
        return
    }
    method null {} {
        return [my Command null]                ; # <1>
    }
    method version {} {
        return [my Command version]
    }
    method query {what args} {
        return [my Command query $what {*}$args]
    }
    method domainop {domain opname args} {
        return [my Command domainop $domain $opname {*}$args]
    }
    method create {domain class} {
        return [my Command create $domain $class]
    }
    method delete {domain class inst} {
        return [my Command delete $domain $class $inst]
    }
    method read {domain class inst args} {
        return [my Command read $domain $class $inst {*}$args]
    }
    method update {domain class inst args} {
        return [my Command update $domain $class $inst {*}$args]
    }
    method signal {domain class inst event args} {
        return [my Command signal $domain $class $inst $event {*}$args]
    }
    method delaysignal {domain class inst delay event args} {
        return [my Command delaysignal $domain $class $inst $delay $event {*}$args]
    }
    method cancel {domain class inst event} {
        return [my Command cancel $domain $class $inst $event]
    }
    method remaining {domain class inst event} {
        return [my Command remaining $domain $class $inst $event]
    }
    method createasync {domain class event args} {
        return [my Command createasync $domain $class $event {*}$args]
    }
    method eloop {args} {
        return [my Command eloop {*}$args]
    }
    method trace {args} {
        return [my Command trace {*}$args]
    }
    method waitForEventTrace {args} {
        my variable tracesReceived
        my variable traceSyncVar
    
        set expect $args
        while {true} {
            while {[$tracesReceived size] != 0} {
                set actual [$tracesReceived get]
    
                if {[my MatchTrace $actual $expect]} {
                    return $actual
                } else {
                    log::debug "discarding trace, \"$actual\":\
                            failed to match, \"$expect\""
                }
            }
    
            set resolvedVarName [my varname traceSyncVar]
            set timer [expr {$timeout > 0 ?\
                [after $timeout [list set $resolvedVarName TIMEOUT]] : {}}]
            vwait $resolvedVarName
    
            if {$traceSyncVar eq "TIMEOUT"} {
                my Throw "timed out on receiving event traces"
            } elseif {$traceSyncVar eq "FATAL"} {
                my Throw "fatal run-time error"
            } else {
                if {$timer ne {}} {
                    after cancel $timer
                }
            }
        }
    }
    method MatchTrace {trace pattern} {
        set matchCount 0
        dict for {key value} $pattern {
            if {[dict exists $trace $key] &&\
                    [string match $value [dict get $trace $key]]} {
                incr matchCount
            }
        }
    
        return [expr {$matchCount == [dict size $pattern] ? "true" : "false"}]
    }
    method clearEventTraceCache {} {
        my variable tracesReceived
        while {[$tracesReceived size] != 0} {
            $tracesReceived get
        }
        return
    }
    method formatEventTraces {{begin 1} {finish end}} {
        set traces [pipe {
            my RestrictTraces $begin $finish Trace |
            rvajoin ~ [relvar set TransitionTrace] Transition |
            rvajoin ~ [relvar set PolymorphicTrace] Polymorphic |
            rvajoin ~ [relvar set CreationTrace] Creation
        }]                                                      ; # <1>
    
        set listing [list]                                      ; # <2>
        relation foreach trace $traces -ascending TraceId {
            relation assign $trace
            set line {}
            append line [format "% 3u " $TraceId]
            if {[relation isnotempty $Transition]} {
                relation assign $Transition Current New
    
                append line [format\
                    "%s: Transition: %s - %s -> %s: %s ==> %s"\
                    $Time $Source $Event $Target $Current $New\
                ]
            } elseif {[relation isnotempty $Polymorphic]} {
                relation assign $Polymorphic Relationship NewEvent Subclass
    
                append line [format\
                    "%s: Polymorphic: %s - %s -> %s: %s - %s -> %s"\
                    $Time $Source $Event $Target $Relationship $NewEvent $Subclass\
                ]
            } elseif {[relation isnotempty $Creation]} {
                append line [format\
                    "%s: Creation: %s - %s -> %s"\
                    $Time $Source $Event $Target\
                ]
            }
    
            lappend listing $line
        }
    
        return [join $listing "\n"]
    }
    method RestrictTraces {begin finish which} {
        if {$begin == 1 && $finish eq "end"} {                  ; #  <1>
            set traces [relvar set $which]
        } else {
            if {$finish eq "end"} {
                set finish [relation cardinality [relvar set $which]]
            } elseif {![string is integer $finish]} {
                my Throw "bad finish value, \"$finish\""
            }
            set traces [relation restrictwith [relvar set $which]\
                    {$TraceId >= $begin && $TraceId <= $finish}]
        }
        return $traces
    }
    method discardEventTraces {} {
        variable traceId
        set traceId 0                   ; # <1>
        relvar eval {
            relvar set Trace [relation empty [relvar set Trace]]
            relvar set TransitionTrace [relation empty [relvar set TransitionTrace]]
            relvar set PolymorphicTrace [relation empty [relvar set PolymorphicTrace]]
            relvar set CreationTrace [relation empty [relvar set CreationTrace]]
        }                               ; # <2>
        return
    }
    method traceNotify {args} {
        my variable tracePrefix
        if {[llength $args] == 1} {
            set tracePrefix [lindex $args 0]
        } elseif {[llength $args] > 1} {
            my Throw "wrong number of arguments"
        }
        return $tracePrefix
    }
    method NotifyTraceArrived {trace} {
        my variable tracePrefix
        if {$tracePrefix eq {}} {
            return
        }
    
        try {
            eval [linsert $tracePrefix end $trace]
        } on error {result} {
            log::error "error notifying trace arrival: \"$result\""
            set tracePrefix {}                                          ; # <1>
        }
    }
    method seqDiag {{begin 1} {finish end}} {
        my variable seqDiagConfig
        lappend uml "@startuml"
        lappend uml "!pragma teoz true"
    
        set traces [my RestrictTraces $begin $finish Trace]
    
        set participants [dict get $seqDiagConfig -participants]
        if {[llength $participants] == 0} {
            set srcInsts [pipe {
                relation project $traces TraceId Source |
                relation rename ~ Source Name
            }] ;                                                                    # <1>
            set trgInsts [pipe {
                relation project $traces TraceId Target |
                relation rename ~ Target Name |
                relation update ~ t {1} {
                    tuple update $t TraceId [expr {[tuple extract $t TraceId] + 1}]}
            }] ;                                                                    # <2>
            set insts [pipe {
                relation union $srcInsts $trgInsts |
                relation summarizeby ~ Name s First int {rmin($s, "TraceId")} |
                relation list ~ Name -ascending First
            }] ;                                                                    # <3>
        } else {
            set insts $participants
        }
    
        set extlabel BOUNDARY ;        # <1>
        set bdindex [lsearch -exact $insts {?.?}]
        if {$bdindex != -1} {
            set insts [lreplace $insts $bdindex $bdindex $extlabel]
        }
        foreach inst $insts {
            set ptype [expr {$inst eq $extlabel ? "boundary" : "participant"}]
            lappend uml "$ptype \"$inst\""
        }
    
        if {[dict get $seqDiagConfig -showstates]} {
            set initialTransitions [pipe {
                relation join $traces [relvar set TransitionTrace] |
                relation summarizeby ~ Target s TraceId int {rmin($s, "TraceId")} |
                relation join ~ [relvar set TransitionTrace]
            }] ;                                                                      # <1>
            
            set initialStatePrefix {} ;
            relation foreach trans $initialTransitions {
                relation assign $trans
                if {$Target ni $insts} {
                    continue
                }
                if {$Current ne "@"} {
                    lappend uml "$initialStatePrefix rnote over \"$Target\" : $Current" ; # <2>
                    set initialStatePrefix & ;                                         # <3>
                }
            }
        }
    
        set traces [pipe {
            rvajoin $traces [relvar set TransitionTrace] Transition |
            rvajoin ~ [relvar set PolymorphicTrace] Polymorphic |
            rvajoin ~ [relvar set CreationTrace] Creation
        }]
    
        relation foreach trace $traces -ascending TraceId {
            relation assign $trace
    
            if {$Source eq "?.?"} {
                set Source $extlabel
            }
    
            if {!($Source in $insts && $Target in $insts)} {
                continue
            }
    
            if {[relation isnotempty $Transition]} {
                relation assign $Transition
                lappend uml "\"$Source\" --> \"$Target\" : $Event"
                if {[dict get $seqDiagConfig -showstates]} {
                    switch -exact -- $New {
                        CH {
                            lappend uml "hnote over \"$Target\" #red : Can't Happen!"
                        }
                        IG {
                            lappend uml "hnote over \"$Target\" #yellow : Ignored"
                        }
                        default {
                            lappend uml "rnote over \"$Target\" : $New"
                        }
                    }
                }
            } elseif {[relation isnotempty $Creation]} {
                lappend uml "create \"$Target\""
                lappend uml "\"$Source\" -> \"$Target\" : $Event <<create>>"
            } elseif {[relation isnotempty $Polymorphic]} {
                relation assign $Polymorphic
                lappend uml "\"$Source\" --> \"$Target\" :\
                        $Event <<poly \[$Relationship\]>>"
            }
        }
    
        lappend uml "@enduml"
    
        return [join $uml "\n"]
    }
    method seqDiagConfig {args} {
        if {[llength $args] % 2 != 0} {
            my Throw "options must be given as name / value pairs, got \"$args\""
        }
        my variable seqDiagConfig
    
        foreach {optname optvalue} $args {
            if {[dict exists $seqDiagConfig $optname]} {
                dict set seqDiagConfig $optname $optvalue
            } else {
                my Throw "unknown sequence diagram option, \"$optname\""
            }
        }
    
        return $seqDiagConfig
    }
    method seqDiagToChan {channel {begin 1} {finish end}} {
        chan puts $channel [my seqDiag $begin $finish]
        return
    }
    method seqDiagToFile {file {begin 1} {finish end}} {
        set channel [open $file w]
        try {
            my seqDiagToChan $channel $begin $finish
        } finally {
            chan close $channel
        }
        return
    }
    method instr {args} {
        return [my Command instr {*}$args]
    }
    method waitForInstrTrace {args} {
        my variable instrReceived
        my variable instrSyncVar
    
        set expect $args
        while {true} {
            while {[$instrReceived size] != 0} {
                set actual [$instrReceived get]
    
                if {[my MatchTrace $actual $expect]} {
                    return $actual
                } else {
                    log::debug "discarding trace, \"$actual\":\
                            failed to match, \"$expect\""
                }
            }
    
            set resolvedVarName [my varname instrSyncVar]
            set timer [expr {$timeout > 0 ?\
                [after $timeout [list set $resolvedVarName TIMEOUT]] : {}}]
            vwait $resolvedVarName
    
            if {$instrSyncVar eq "TIMEOUT"} {
                my Throw "timed out on receiving event traces"
            } elseif {$instrSyncVar eq "FATAL"} {
                my Throw "fatal run-time error"
            } else {
                if {$timer ne {}} {
                    after cancel $timer
                }
            }
        }
    }
    method clearInstrTraceCache {} {
        my variable instrReceived
        while {[$instrReceived size] != 0} {
            $instrReceived get
        }
    }
    method formatInstrTraces {{begin 1} {finish end}} {
        set listing [list]
        set instrs [my RestrictTraces $begin $finish Instrumentation]
    
        relation foreach instr $instrs -ascending TraceId {
            relation assign $instr
            lappend listing [format "% 3u %s: %s" $TraceId $Time $Message]
        }
    
        return [join $listing "\n"]
    }
    method discardInstrTraces {} {
        my variable instrId
        set instrId 0
        relvar eval {
            relvar set Instrumentation [relation empty [relvar set Instrumentation]]
        }
        return
    }
    method instrNotify {args} {
        my variable instrPrefix
        if {[llength $args] == 1} {
            set instrPrefix [lindex $args 0]
        } elseif {[llength $args] > 1} {
            my Throw "wrong number of arguments"
        }
        return $instrPrefix
    }
    method NotifyInstrArrived {instr} {
        my variable instrPrefix
        if {$instrPrefix eq {}} {
            return
        }
    
        try {
            eval [linsert $instrPrefix end $instr]
        } on error {result} {
            log::error "error notifying instrumentation arrival: \"$result\""
            set instrPrefix {}
        }
    }
    method waitForFatalTrace {args} {
        my variable fatalReceived
        my variable fatalSyncVar
    
        set expect $args
        while {true} {
            while {[$fatalReceived size] != 0} {
                set actual [$fatalReceived get]
    
                if {[my MatchTrace $actual $expect]} {
                    return $actual
                } else {
                    log::debug "discarding trace, \"$actual\":\
                            failed to match, \"$expect\""
                }
            }
    
            set resolvedVarName [my varname fatalSyncVar]
            set timer [expr {$timeout > 0 ?\
                [after $timeout [list set $resolvedVarName TIMEOUT]] : {}}]
            vwait $resolvedVarName
    
            if {$fatalSyncVar eq "TIMEOUT"} {
                my Throw "timed out on receiving event traces"
            } else {
                if {$timer ne {}} {
                    after cancel $timer
                }
            }
        }
    }
    method clearFatalTraceCache {} {
        my variable fatalReceived
        while {[$fatalReceived size] != 0} {
            $fatalReceived get
        }
    }
    method formatFatalTraces {{begin 1} {finish end}} {
        set listing [list]
        set fatals [my RestrictTraces $begin $finish Fatal]
    
        relation foreach fatal $fatals -ascending TraceId {
            relation assign $fatal
            lappend listing [format "% 3u %s: %s" $TraceId $Time $Message]
        }
    
        return [join $listing "\n"]
    }
    method discardFatalTraces {} {
        variable fatalId
        set fatalId 0
        relvar eval {
            relvar set Fatal [relation empty [relvar set Fatal]]
        }
        return
    }
    method fatalNotify {args} {
        my variable fatalPrefix
        if {[llength $args] == 1} {
            set fatalPrefix [lindex $args 0]
        } elseif {[llength $args] > 1} {
            my Throw "wrong number of arguments"
        }
        return $fatalPrefix
    }
    method NotifyFatalArrived {fatal} {
        my variable fatalPrefix
        if {$fatalPrefix eq {}} {
            return
        }
    
        try {
            eval [linsert $fatalPrefix end $fatal]
        } on error {result} {
            log::error "error notifying fatal error arrival: \"$result\""
            set fatalPrefix {}
        }
    }
    method saveTraces {file {how ral}} {
        switch -exact -- $how {
            ral {
                serializeToFile $file [self namespace]::*
            }
            sqlite {
                storeToSQLite $file [self namespace]::*
            }
            default {
                my Throw "unknown trace file type, \"$how\""
            }
        }
        return
    }
    method Puts {cmd} {
        log::debug "harness command: \"$cmd\""
        puts $connection $cmd
    }
    method HandleHarnessInput {} {
        set line {}
        for {set gotline false} {!$gotline} {set gotline [string is list $line]} {
            set llen [chan gets $connection input]
            if {$llen == -1} {
                if {[chan eof $connection]} {
                    log::warn "EOF on harness input -- closing \"$connection\""
                    chan close $connection
                    unset -nocomplain connection
                    return
                } elseif {[chan blocked $connection]} {
                    log::notice "partial line received"
                }
            } else {
                append line $input
            }
        }
        if {[string length $line] != 0} {
            log::debug "harness response: \"$line\""
        
            lassign $line resp_type resp_value
        
            switch -exact -- $resp_type {
                cmd {
                    my HandleCmdResponse $resp_value
                }
                trace {
                    my HandleTraceResponse $resp_value
                }
                fatal {
                    my HandleFatalResponse $resp_value
                }
                instr {
                    my HandleInstrResponse $resp_value
                }
                default {
                    my Throw "unknown response type, \"$resp_value\""
                }
            }
        }
    }
    method HandleCmdResponse {respValue} {
        set [my varname cmdSyncVar] $respValue
        return
    }
    method HandleTraceResponse {respValue} {
        my variable traceId
        incr traceId
    
        relvar eval {
            switch -exact -- [dict get $respValue type] {
                transition {
                    relvar insert TransitionTrace [list\
                        TraceId     $traceId\
                        Current     [dict get $respValue currstate]\
                        New         [dict get $respValue newstate]\
                    ]
                }
                polymorphic {
                    relvar insert PolymorphicTrace [list\
                        TraceId         $traceId\
                        Relationship    [dict get $respValue relationship]\
                        NewEvent        [dict get $respValue newevent]\
                        Subclass        [dict get $respValue subclass]\
                    ]
                }
                creation {
                    relvar insert CreationTrace [list\
                        TraceId     $traceId\
                    ]
                }
                default {
                    log::error "unknown state machine trace type,\
                            \"[dict get $respValue type]\""
                    incr traceId -1
                    return                                              ; # <1>
                }
            }
    
            relvar insert Trace [list\
                TraceId     $traceId\
                Time        [dict get $respValue time]\
                Event       [dict get $respValue event]\
                Source      [dict get $respValue source]\
                Target      [dict get $respValue target]\
            ]
        }
    
        my variable tracesReceived
        $tracesReceived put $respValue
        set [my varname traceSyncVar] TRACE
    
        my NotifyTraceArrived $respValue
    
        return
    }
    method HandleInstrResponse {respValue} {
        variable instrReceived
        $instrReceived put $respValue
    
        variable instrId
        incr instrId
        relvar insert Instrumentation [list\
            TraceId     $instrId\
            Time        [dict get $respValue time]\
            Message     [dict get $respValue message]\
        ]
    
        set [my varname instrSyncVar] INSTR
    
        my NotifyInstrArrived $respValue
    
        return
    }
    method HandleFatalResponse {respValue} {
        my variable fatalReceived
        $fatalReceived put $respValue
    
        variable fatalId
        incr fatalId
        relvar insert Fatal [list\
            TraceId     $fatalId\
            Time        [dict get $respValue time]\
            Message     [dict get $respValue message]\
        ]
    
        log::error "received fatal error response, \"$respValue\""
        set [my varname fatalSyncVar] FATAL
        set [my varname cmdSyncVar] FATAL
        set [my varname traceSyncVar] FATAL
    
        my NotifyFatalArrived $respValue
    
        return
    }
    method Command {args} {
        set resolvedVarName [my varname cmdSyncVar]
        set timer [expr {$timeout > 0 ?\
            [after $timeout [list set $resolvedVarName TIMEOUT]] : {}}]
    
        my Puts $args                                   ; # <1>
    
        vwait $resolvedVarName                          ; # <2>
    
        set cmdName [lindex $args 0]
        my variable cmdSyncVar
    
        if {$cmdSyncVar eq "TIMEOUT"} {
            my Throw "timeout for command, \"$cmdName\""
        } elseif {$cmdSyncVar eq "FATAL"} {
            my Throw "fatal run-time error while executing, \"$cmdName\""
        } else {
            if {$timer ne {}} {
                after cancel $timer
            }
        }
    
        if {[dict get $cmdSyncVar name] ne $cmdName} {
            my Throw "expected response for command,\
                    \"$cmdName\",\
                    got, \"[dict get $cmdSyncVar name]\""
        }
    
        set result [dict get $cmdSyncVar result]        ; # <3>
        if {[dict get $cmdSyncVar status] eq "error"} {
            my Throw $result
        }
    
        return $result
    }
    method Throw {message} {
        tailcall uplevel 1 [list throw [list {*}[self caller] $message] $message]
    }
}
proc ::mecate::eventTraceFormat {trace} {
    dict with trace {
        switch -exact -- $type {
            transition {
                return [format\
                    "%s: Transition: %s - %s -> %s: %s ==> %s"\
                    $time $source $event $target $currstate $newstate\
                ]
            }
            polymorphic {
                return [format\
                    "%s: Polymorphic: %s - %s -> %s: %s - %s -> %s"\
                    $time $source $event $target $relationship $newevent\
                    $subclass\
                ]
            }
            creation {
                return [format\
                    "%s: Creation: %s - %s -> %s"\
                    $time $source $event $target\
                ]
            }
            default {
                my Throw "unknown trace type, \"$type\""
            }
        }
    }
}
proc ::mecate::instrTraceFormat {trace} {
    dict with trace {
        return [format "%s: Instr: %s" $time $message]
    }
}
proc ::mecate::fatalTraceFormat {trace} {
    dict with trace {
        return [format "%s: Fatal: %s" $time $message]
    }
}

package provide mecate $::mecate::version
