#! /usr/bin/env tclsh
# Copyright (c) 2015, 2023 D. Bohdan
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
# THE SOFTWARE.

namespace eval ::wordchan {
    namespace export initialize watch read write
    namespace ensemble create

    variable maxBytes 4095
    variable storage {}
    variable version 0.1.1
}

proc ::wordchan::initialize {channelId mode} {
    variable storage
    dict set storage $channelId data {}
    dict set storage $channelId ticktock 0
    return [list initialize finalize watch read write]
}

proc ::wordchan::finalize channelId {
    variable storage
    dict unset storage $channelId
}

proc ::wordchan::watch {channelId eventspec} {}

proc ::wordchan::read {channelId count} {
    # We ignore $count.
    variable storage

    # Force one value to be read at a time.
    if {[TickTock $channelId]} {
        error EAGAIN
    } else {
        set chanData [lassign [dict get $storage $channelId data] head]
        dict set storage $channelId data $chanData
        return $head
    }
}

proc ::wordchan::write {channelId data} {
    variable maxBytes
    variable storage

    if {[string length [encoding convertto $data]] > $maxBytes} {
        error [list written value [string range $data 0 31]... exceeds \
            $maxBytes bytes]
    }

    set chanData [dict get $storage $channelId data]
    dict set storage $channelId data [list {*}$chanData $data]
    return [string length $data]
}

# Private API.

proc ::wordchan::TickTock {channelId} {
    variable storage
    set ticktock [dict get $storage $channelId ticktock]
    dict set storage $channelId ticktock [expr {!$ticktock}]
    return $ticktock
}

proc ::wordchan::Test {} {
    variable maxBytes

    set ch [chan create {read write} ::wordchan]
    chan configure $ch -buffering none

    puts -nonewline $ch [list a]
    puts -nonewline $ch [list b c]

    set readRes [::read $ch]
    if {$readRes ne {a}} {
        error [list wrong value: $readRes]
    }
    set readRes [::read $ch]
    if {$readRes ne {b c}} {
        error [list wrong value: $readRes]
    }

    for {set i 0} {$i <= $maxBytes} {incr i} {
        set id [format %04u- $i]
        set value $id[string repeat x [expr { $i - [string length $id] }]]

        puts -nonewline $ch $value
        if {[set readRes [::read $ch]] != $value} {
            error [list wrote $value but read $readRes]
        }
    }

    catch {
        puts -nonewline $ch +[string repeat x $maxBytes]
    } err
    if {![regexp exceeds $err]} {
        error [list did not get the expected error message in $err]
    }
}

# If this is the main script...
if {[info exists argv0] && ([file tail [info script]] eq [file tail $argv0])} {
    ::wordchan::Test
}

#! /usr/bin/env tclsh

source wordchan.tcl

proc main {} {
    set ch [chan create {read write} ::wordchan]
    chan configure $ch -buffering none
    puts -nonewline $ch HELLO
    puts -nonewline $ch WORLD
    puts [read $ch] ;# Prints "HELLO".
    puts [read $ch] ;# Prints "WORLD".
}

main