# Library to add a timestamp to each line of output
#
# Usage:timestamp ?channel? <channelId> ?optionName value? ...
#       timestamp configure <channelId> ?optionName value? ...
#
# Available options:
#       -format <format>
#               Specifies the format of the time stamp in a method similar to
#               the [clock format] command, with two additional format groups:
#               %n: three-digit number giving the current milliseconds within
#                   the second.
#               %v: six-digit number giving the current microseconds within
#                   the second.

namespace eval timestamp {
    # Ensemble for the user
    namespace ensemble create -subcommands {channel configure} \
      -unknown [namespace current]::default
    # Ensemble for transchan
    namespace ensemble create -command transchan -parameters fd \
      -subcommands {initialize finalize write}
    # Define the available options and their default values
    variable defaultcfg {
        -format {%Y-%m-%d %T.%n:}
    }
}

proc timestamp::default {command subcommand args} {
    return [list $command channel $subcommand]
}

proc timestamp::channel {fd args} {
    set argc [llength $args]
    if {$argc % 2} {
        return -code error "wrong # args: should be\
          \"timestamp channel channel ?-option value ...?\""
    }
    # Reduce buffering to line for at least reasonably accurate time stamps
    if {[chan configure $fd -buffering] eq "full"} {
        chan configure $fd -buffering line
    }
    # Install the transchan
    chan push $fd [list [namespace which transchan] $fd]
    if {$argc == 0} return
    tailcall configure $fd {*}$args
}

proc timestamp::configure {fd args} {
    variable cfg
    if {![info exists cfg($fd)]} {
        return -code error "can not find channel named \"$fd\""
    }
    set argc [llength $args]
    if {$argc == 0} {
        return $cfg($fd)
    }
    if {$argc == 1} {
        set opt [lindex $args 0]
        if {[dict exists $cfg($fd) $opt]} {
            return [dict get $cfg($fd) $opt]
        } else {
            return -code error "bad option \"$opt\""
        }
    }
    if {$argc % 2} {
        return -code error "wrong # args: should be\
          \"timestamp configure ?-option value ...?\""
    }
    set newcfg [dict merge $cfg($fd) $args]
    if {[dict size $newcfg] == [dict size $cfg($fd)]} {
        set cfg($fd) $newcfg
        return
    }
    set opt [lindex [dict keys $newcfg] [dict size $cfg($fd)]]
    return -code error "bad option \"$opt\""
}

proc timestamp::initialize {fd chan mode} {
    variable defaultcfg
    variable cfg
    variable newline
    # Initialize the per channel data structures
    set cfg($fd) $defaultcfg
    set newline($fd) 1
    # Return the available subcommands
    return [namespace ensemble configure transchan -subcommands]
}

proc timestamp::finalize {fd chan} {
    variable cfg
    variable newline
    # Clean up the used data structures
    unset cfg($fd)
    unset newline($fd)
}

proc timestamp::ts {fd} {
    variable cfg
    # Get the current time in microseconds resolution
    set now [clock microseconds]
    set fmtstr [dict get $cfg($fd) -format]
    # Clock format strings are converted into procs that stay around for the
    # lifetime of the application. So it's not a good idea to have a million
    # different format strings for each microseconds value. For that reason
    # the clock format must be performed before the %n and %v mapping.
    set tsformat [string map {%% %%%% %n %%n %v %%v} $fmtstr]
    set timestr [clock format [expr {$now / 1000000}] -format $tsformat]
    if {[string length $tsformat] != [string length $fmtstr]} {
        # One or more additional format groups are present
        set us [expr {$now % 1000000}]
        set map {%% %}
        lappend map %n [format %03d [expr {$us / 1000}]] %v [format %06d $us]
        # Create the final timestamp
        return [string map $map $timestr]
    } else {
        return $timestr
    }
}

proc timestamp::write {fd chan data} {
    variable newline
    # Ignore empty writes
    if {$data eq ""} return
    # Divide the received data into lines
    set lines [lassign [split $data \n] line]
    # Only build the timestamp once per block of data
    set ts [ts $fd]
    set out ""
    # When starting on a new line, output the time stamp
    if {$newline($fd)} {
        append out $ts " "
    }
    append out $line
    # Only do something more when there is a newline in the data
    if {[llength $lines] > 0} {
        # Don't ouput a timestamp after a final newline in the data block
        if {[lindex $lines end] eq {}} {
            set newline($fd) 1
            set lines [lreplace $lines end end]
        } else {
            set newline($fd) 0
        }
        # Prepended a timestamp to each line
        foreach line $lines {
            append out \n $ts " " $line
        }
        if {$newline($fd)} {
            # Add back the final newline
            append out \n
        }
    } else {
        # Not at the start of a new line
        set newline($fd) 0
    }
    return $out
}

package require timestamp
timestamp stdout -format %T.%v>
puts Hello!
after 1234
puts Bye!

15:41:50.145864> Hello!
15:41:51.410124> Bye!