#
# Copyright (c) 2012-2014, 2016-2017, 2019, 2025-2026 LAAS/CNRS
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software for any purpose
# with or without   fee is hereby granted, provided   that the above  copyright
# notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH
# REGARD TO THIS  SOFTWARE INCLUDING ALL  IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS. IN NO EVENT SHALL THE AUTHOR  BE LIABLE FOR ANY SPECIAL, DIRECT,
# INDIRECT, OR CONSEQUENTIAL DAMAGES OR  ANY DAMAGES WHATSOEVER RESULTING  FROM
# LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
# OTHER TORTIOUS ACTION,   ARISING OUT OF OR IN    CONNECTION WITH THE USE   OR
# PERFORMANCE OF THIS SOFTWARE.
#
#                                            Anthony Mallet on Sat Apr  7 2012
#

namespace eval genomix::module {
  variable modules [dict create]
  variable rassoc
  array set rassoc {}


  # --- load ---------------------------------------------------------------
  #
  variable loadusage [join {
    "Usage:\n\t load %s" {[-h] [client options] [as alias]}
    "\n\nClient options:\n%s"
  }]

  proc load {token client args} {
    variable modules
    variable rassoc

    set cargs [list]
    while {[llength $args]} {
      set args [lassign $args arg]
      switch -- $arg {
        -h { set args [lassign $args usage] }
        as { set args [lassign $args alias] }
        default { lappend cargs $arg }
      }
    }
    if {[info exists usage]} {
      variable loadusage

      set opts [$token options $client]
      foreach i [lsort -int [dict keys $opts]] {
        set opt [dict get $opts $i]
        append ustr [format "  %-26s %s\n" \
                         [dict get $opt option] [dict get $opt descr]]
      }
      if {![info exists ustr]} { set ustr "  (none)\n" }

      return [format $loadusage $client $ustr]
    }

    set cmd [$token dlopen $client $cargs]
    if {![info exists alias]} {
      set alias $cmd
    }
    if {[dict exists $modules $alias]} {
      error "$alias exists"
    }
    set rassoc($token,$cmd) $alias
    dict set modules $alias client $client
    dict set modules $alias args $args
    dict set modules $alias token $token
    dict set modules $alias cmd $cmd
    dict set modules $alias requests [dict create]

    set info [$token info $cmd]

    catch { namespace delete ::$cmd }
    dict for {s meta} [dict get $info services] {
      if {![catch {dict get $meta meta} m]} {
        set defarg [genomix::pmt::meta2defarg $m]
      } else {
        set defarg [dict create]
      }
      interp alias {} ::${alias}::$s \
          {} genomix::module::rqst $token $alias $s $meta $defarg
    }
    dict for {p meta} [dict get $info ports] {
      interp alias {} ::${alias}::$p \
          {} genomix::module::port $token $alias $p $meta
    }
    if {[dict exists $info pubs]} {
      dict for {p meta} [dict get $info pubs] {
        interp alias {} ::${alias}::$p \
            {} genomix::module::pub $token $alias $p $meta
      }
    }

    return $alias
  }


  # --- forget -------------------------------------------------------------
  #
  proc forget {token name} {
    variable modules
    variable rassoc

    catch {
      unset rassoc($token,[client $name])
      namespace delete ::$name
    }
    dict unset modules $name
    return
  }


  # --- client -------------------------------------------------------------
  #
  proc client {name} {
    variable modules
    if {[catch {dict get $modules $name cmd} cmd]} {
      error "$name does not exist"
    }

    return $cmd
  }


  # --- rqst ---------------------------------------------------------------
  #
  variable rqstusage [join {
    "Usage:\n\t %s" {[-id var] [-s|-send] [-a|-ack] [-o|-oneway]}
    "\n\t\t" { [-t|-timeout milli] [-f|-flat] [-args] [-h]}
    "\n\t\t" { [--] input [& ?script?]}
    "\n\nInput dictionary:%s"
  }]

  proc rqst { token module service metadata defarg args } {
    variable rqstusage
    variable modules

    set cmd [client $module]
    set cb {}
    set fmt dict
    set wait done
    set timeout 0
    set params [dict create]
    set now [clock milli]

    # look for ``&'' ?script?
    if {[set & [lsearch $args &]] >= 0} {
      set wait sent
      set cb [lrange $args ${&}+1 end]
      set args [lrange $args 0 ${&}-1]
    }

    # process options
    while {[llength $args]} {
      set args [lassign $args arg]
      if {[regexp -- {(--?.+)=(.+)} $arg m o a]} {
        set arg $o
        set args [linsert $args 0 $a]
      }

      switch -glob -- $arg {
        -id { set args [lassign $args idvar] }
        -o - -oneway { set wait no; dict set params oneway 1 }
        -s - -send { set wait no }
        -a - -ack { set wait sent }
        -t - -timeout {
          set args [lassign $args timeout]
          set timeout [expr {$now+$timeout}]
        }
        -f - -flat { set fmt flat }

        -- break
        -args { return $metadata }
        -h {
          dict with metadata {}
          return [format $rqstusage ${cmd}::$service \
                      [genomix::pmt::meta2doc $input $meta]]
        }
        -* { error "unknown option -- $arg" }

        default {
          set args [linsert $args 0 $arg]
          break
        }
      }
    }

    # create json argument
    dict with metadata {}
    switch -- [llength $args] {
      0 {
        if {[llength $input]} {
          if {$fmt == "flat"} { error "-f requires arguments" }
          set args [genomix::pmt::iscanargs $input $meta]

          # update history
          if {[llength $args]} {
            set h "::${module}::${service}"
            if {[info exists idvar]} { append h " -id $idvar" }
            if {$wait == "no"} { append h " -send" }
            if {$wait == "sent"} { append h " -ack" }
            if {$timeout > 0} { append h " -timeout [expr {$timeout-$now}]" }
            set h [linsert $h end $args]
            if {[llength $cb]} { append h " & $cb" }
            catch {
              el::history change $h 0
              history change $h 0
            }
          }
        }
      }
      1 {
        if {$fmt == "flat" || [catch {dict size [lindex $args 0]}]} {
          set fmt flat
        } else {
          lassign $args args
        }
      }
      default { set fmt flat }
    }
    set json [genomix::pmt::arg2json $fmt $args $defarg $input]
    dict set params input $json

    # send remotely
    set r [$token send $cmd $service $params]
    if {[dict exists $params oneway]} return

    set id ${module}::$r
    if [info exists idvar] { uplevel 1 [list set $idvar $id] }

    set cid [interp alias {} ::$id \
                 {} ::genomix::module::rqstid $token $module $r]
    dict set modules $module requests $r cid $cid
    if {$cb != ""} {
      if {$wait == "no" } {
        dict set modules $module requests $r sentcb [concat $cb $id]
      }
      dict set modules $module requests $r cb [concat $cb $id]

      # a reply may already be here because server::get enters the event
      # loop. In this case, the callbacks were not processed (since not yet in
      # the data struct)
      switch [rstatus $module $r] {
        sent { if {$wait == "no"} { after idle $cb $id } }
        error - done { after idle $cb $id }
      }
    }

    # wait for a reply
    switch $wait {
      done {
        if {[catch {rwait done $timeout $module $r} err opt]} {
          # clean request
          catch { result $token $module $r }
          return -options $opt $err
        }
        return [result $token $module $r]
      }
      sent {
        catch { rwait sent $timeout $module $r }
        return $id
      }
      no {
        return $id
      }
    }
  }


  # --- port ---------------------------------------------------------------
  #
  variable portusage [join {
    "Usage:\n\t %s" {[-c|-connect] [-d|-disconnect] [-h] [--]%s}
    "\n\nData dictionary:%s"
  }]

  proc port { token module port metadata args } {
    variable portusage
    variable modules
    set cmd [client $module]

    set sub read
    dict with metadata {}
    while {[llength $args]} {
      set args [lassign $args arg]
      switch -glob -- $arg {
        -- break
        -c - -connect { set sub portconnect }
        -d - -disconnect { set sub portdisconnect }
        -h {
          return [format $portusage ${cmd}::$port	\
                      [expr {$simple ? "" : " name"}]	\
                      [genomix::pmt::meta2doc $data $meta]]
        }
        -* { error "unknown option -- $arg" }

        default {
          set args [linsert $args 0 $arg]
          break
        }
      }
    }

    if {$simple} {
      if {[llength $args] != 0} {
        error "${cmd}::$port expects no argument"
      }
    } else {
      if {[llength $args] != 1} {
        error "${cmd}::$port expects a port handle name argument"
      }
      lassign $args name
      append port /$name
    }

    return [$token $sub $cmd $port]
  }


  # --- pub ----------------------------------------------------------------
  #
  proc pub { token module port metadata args } {
    variable modules
    set cmd [client $module]

    while {[llength $args]} {
      set args [lassign $args arg]
      switch -glob -- $arg {
        -- break
        -h { return [format "Usage:\n\t %s \[-h\] name" ${cmd}::$port] }
        -* { error "unknown option -- $arg" }

        default {
          set args [linsert $args 0 $arg]
          break
        }
      }
    }
    if {[llength $args] != 1} {
      error "${cmd}::$port expects a port name argument"
    }
    lassign $args name

    set p [$token pub $cmd $port open $name]

    set id ${module}::${port}::$p
    interp alias {} ::$id \
        {} genomix::module::pubid $token $module $port $p $metadata
    return $id
  }


  # --- pubid --------------------------------------------------------------
  #
  variable pubidusage [join {
    "Usage:\n\t %s" {[-h] [-n|-name] [-d|-data] [-c|-close]}
    "\n\t\t" {[-f|-flat] [--] ?data?}
    "\n\nInput data:%s"
  }]
  proc pubid { token module port id metadata args } {
    variable pubidusage
    variable modules

    set cmd [client $module]
    set op write
    set fmt dict

    while {[llength $args]} {
      set args [lassign $args arg]
      if {[regexp -- {(--?.+)=(.+)} $arg m o a]} {
        set arg $o
        set args [linsert $args 0 $a]
      }

      switch -glob -- $arg {
        -d - -data { set op data }
        -c - -close { set op close }
        -n - -name { set op name }
        -f - -flat { set fmt flat }

        -- break
        -args { return $metadata }
        -h {
          dict with metadata {}
          return [format $pubidusage ${cmd}::${port}::$id \
                      [genomix::pmt::meta2doc $data $meta]]
        }
        -* { error "unknown option -- $arg" }

        default {
          set args [linsert $args 0 $arg]
          break
        }
      }
    }

    switch $op {
      write {
        # create json argument
        dict with metadata {}
        switch -- [llength $args] {
          0 {
            if {$fmt == "flat"} { error "-f requires arguments" }
            set args [genomix::pmt::iscanargs $data $meta]

            # update history
            if {[llength $args]} {
              set h [list "::${module}::${port}::$id" $args]
              catch {
                el::history change $h 0
                history change $h 0
              }
            }
          }
          1 {
            if {$fmt == "flat" || [catch {dict size [lindex $args 0]}]} {
              set fmt flat
            } else {
              lassign $args args
            }
          }
          default { set fmt flat }
        }
        set json [genomix::pmt::arg2json $fmt $args {} $data]

        # send
        $token pub $cmd $port $op $id [dict create data $json]
      }
      data {
        return [genomix::json::json2dict [$token pub $cmd $port $op $id]]
      }
      close {
        rename ::${module}::${port}::$id {}
        $token pub $cmd $port $op $id
      }
      name { return $id }

      default { error "unknown op $op" }
    }

    return
  }


  # --- rqstid -------------------------------------------------------------
  #
  variable rqstidusage [concat {*}{
    {usage: %s [-t|-timeout milli] [-h] [--] result|wait ?status?|status|abort}
  }]
  proc rqstid { token module r args } {
    variable rqstidusage
    set timeout 0
    set now [clock milli]

    while {[llength $args]} {
      set args [lassign $args arg]
      if {[regexp -- {(--?.+)=(.+)} $arg m o a]} {
        set arg $o
        set args [linsert $args 0 $a]
      }

      switch -glob -- $arg {
        -t - -timeout {
          set args [lassign $args timeout]
          set timeout [expr {$now+$timeout}]
        }

        -- break
        -h { return [format $rqstidusage ${module}::$r] }
        -* { error "unknown option -- $arg" }

        default {
          set args [linsert $args 0 $arg]
          break
        }
      }
    }

    set args [lassign $args cmd]
    switch $cmd {
      {} - result {
        if {[llength $args] != 0} {
          error [format $rqstidusage ${module}::$r]
        }
        return [result $token $module $r]
      }

      wait {
        set args [lassign $args expect]
        if {$expect == ""} { set expect done }
        if {[llength $args] != 0} {
          error [format $rqstidusage ${module}::$r]
        }

        if {[catch {rwait $expect $timeout $module $r} m]} {
          if {$m == "timeout"} { error $m }
        }
        return
      }

      status {
        if {[llength $args] != 0} {
          error [format $rqstidusage ${module}::$r]
        }
        return [rstatus $module $r]
      }

      abort {
        return [$token abort $module $r]
      }
    }

    error [format $rqstidusage ${module}::$r]
  }


  # --- result -------------------------------------------------------------
  #
  proc result { token module r } {
    variable modules

    if {[catch {dict get $modules $module requests $r} info]} {
      error "no such request ${module}::$r"
    }
    if {$token == ""} {
      set token [dict get $modules $module token]
    }
    set cmd [client $module]

    dict with info {}
    if {[info exists status]} {
      if {$status == "error" || $status == "done"} {
        interp alias {} $cid {}
        dict unset modules $module requests $r
        catch { $token clean $cmd $r }
      }

      if {$status == "error"} { error $errmsg }
      if {$status == "done"} {
        if {[info exists output]} { return $output } else { return "" }
      }

      error "request ${module}::$r in progress ($status)"
    }

    error "request ${module}::$r not yet sent??"
  }


  # --- rstatus ------------------------------------------------------------
  #
  proc rstatus { module r } {
    variable modules

    if {![catch {dict get $modules $module requests $r} info]} {
      dict with info {}
      if {[info exists status]} { return $status }
    }
    return none
  }


  # --- rwait --------------------------------------------------------------
  #
  proc rwait { expect maxtime module r } {
    variable modules
    set timeout 0

    while 1 {
      if {[catch {dict get $modules $module requests $r} info]} {
        error "no such request ${module}::$r"
      }
      dict with info {}
      if {[info exists status]} {
        if {$status == "error"} { error $errmsg }
        if {$status == $expect} return
        if {$expect == "sent" && $status == "done"} return
      }

      if {$maxtime} {
        set timeout [expr {$maxtime-[clock milli]}]
        if {$timeout <= 0} { error timeout }
      }
      genomix::pmt::mvwait $timeout modules
    }
  }


  # --- reply --------------------------------------------------------------
  #
  proc reply { token json } {
    variable modules
    variable rassoc

    set data [genomix::json::json2dict $json]
    if {[scan [dict get $data id] {%[^:]::%d} cmd r] != 2} {
      error "malformed request id"
    }
    dict unset data id

    set alias $rassoc($token,$cmd)

    if {[catch {dict get $modules $alias requests $r} info]} {
      dict set modules $alias requests $r $data
      return
    }
    dict set modules $alias requests $r [dict merge $info $data]

    switch [dict get $data status] {
      sent {
        if {![catch {dict get $info sentcb} cb]} { after idle $cb }
      }
      default {
        if {![catch {dict get $info cb} cb]} { after idle $cb }
      }
    }
    return
  }
}
